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

Update to .NET 8/9; minor tweaks

Browse Source
This commit is contained in:
Daniel J. Summers 2024-12-23 21:16:34 -05:00
parent 870f87cb17
commit 88841fd3f8
10 changed files with 134 additions and 138 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
build.fs
View File

@ -23,7 +23,7 @@ let version =
let appVersion = generator.Replace("\"Generator\": \"", "") let appVersion = generator.Replace("\"Generator\": \"", "")
let appVersion = appVersion.Substring (0, appVersion.IndexOf "\"") let appVersion = appVersion.Substring (0, appVersion.IndexOf "\"")
appVersion.Split ' ' |> Array.last appVersion.Split ' ' |> Array.last
/// Zip a theme distributed with myWebLog /// Zip a theme distributed with myWebLog
let zipTheme (name : string) (_ : TargetParameter) = let zipTheme (name : string) (_ : TargetParameter) =
let path = $"src/{name}-theme" let path = $"src/{name}-theme"
@ -33,9 +33,9 @@ let zipTheme (name : string) (_ : TargetParameter) =
|> Zip.zipSpec $"{releasePath}/{name}-theme.zip" |> Zip.zipSpec $"{releasePath}/{name}-theme.zip"
/// Frameworks supported by this build /// Frameworks supported by this build
let frameworks = [ "net6.0"; "net8.0" ] let frameworks = [ "net8.0"; "net9.0" ]
/// Publish the project for the given runtime ID /// Publish the project for the given runtime ID
let publishFor rid (_ : TargetParameter) = let publishFor rid (_ : TargetParameter) =
frameworks frameworks
|> List.iter (fun fwk -> |> List.iter (fun fwk ->
@ -65,7 +65,7 @@ let packageFor rid (_ : TargetParameter) =
Target.create "Clean" (fun _ -> Target.create "Clean" (fun _ ->
!! "src/**/bin" !! "src/**/bin"
++ "src/**/obj" ++ "src/**/obj"
|> Shell.cleanDirs |> Shell.cleanDirs
Shell.cleanDir releasePath Shell.cleanDir releasePath
) )
@ -87,7 +87,7 @@ Target.create "RepackageLinux" (fun _ ->
frameworks frameworks
|> List.iter (fun fwk -> |> List.iter (fun fwk ->
let zipArchive = $"{releasePath}/myWebLog-{version}.{fwk}.linux-x64.zip" let zipArchive = $"{releasePath}/myWebLog-{version}.{fwk}.linux-x64.zip"
let sh command args = let sh command args =
CreateProcess.fromRawCommand command args CreateProcess.fromRawCommand command args
|> CreateProcess.redirectOutput |> CreateProcess.redirectOutput
|> Proc.run |> Proc.run

9
src/Directory.Build.props
View File

@ -1,9 +1,10 @@
<Project> <Project>
<PropertyGroup> <PropertyGroup>
<TargetFrameworks>net6.0;net8.0</TargetFrameworks> <TargetFrameworks>net8.0;net9.0</TargetFrameworks>
<DebugType>embedded</DebugType> <DebugType>embedded</DebugType>
<AssemblyVersion>2.2.0.0</AssemblyVersion> <AssemblyVersion>3.0.0.0</AssemblyVersion>
<FileVersion>2.2.0.0</FileVersion> <FileVersion>3.0.0.0</FileVersion>
<Version>2.2.0</Version> <Version>3.0.0</Version>
<VersionSuffix>beta1</VersionSuffix>
</PropertyGroup> </PropertyGroup>
</Project> </Project>

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

@ -5,17 +5,17 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="BitBadger.Documents.Postgres" Version="4.0.0-rc5" /> <PackageReference Include="BitBadger.Documents.Postgres" Version="4.0.0" />
<PackageReference Include="BitBadger.Documents.Sqlite" Version="4.0.0-rc5" /> <PackageReference Include="BitBadger.Documents.Sqlite" Version="4.0.0" />
<PackageReference Include="Microsoft.Data.Sqlite" Version="8.0.8" /> <PackageReference Include="Microsoft.Data.Sqlite" Version="9.0.0" />
<PackageReference Include="Microsoft.Extensions.Caching.Abstractions" Version="8.0.0" /> <PackageReference Include="Microsoft.Extensions.Caching.Abstractions" Version="9.0.0" />
<PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="8.0.0" /> <PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="9.0.0" />
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" /> <PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
<PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.1.0" /> <PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.1.0" />
<PackageReference Include="Npgsql.NodaTime" Version="8.0.4" /> <PackageReference Include="Npgsql.NodaTime" Version="9.0.2" />
<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="8.0.400" /> <PackageReference Update="FSharp.Core" Version="9.0.100" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>

93
src/MyWebLog.Data/SQLite/SQLiteHelpers.fs
View File

@ -5,55 +5,55 @@ module MyWebLog.Data.SQLite.SQLiteHelpers
/// The table names used in the SQLite implementation /// The table names used in the SQLite implementation
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Table = module Table =
/// Categories /// Categories
[<Literal>] [<Literal>]
let Category = "category" let Category = "category"
/// Database Version /// Database Version
[<Literal>] [<Literal>]
let DbVersion = "db_version" let DbVersion = "db_version"
/// Pages /// Pages
[<Literal>] [<Literal>]
let Page = "page" let Page = "page"
/// Page Revisions /// Page Revisions
[<Literal>] [<Literal>]
let PageRevision = "page_revision" let PageRevision = "page_revision"
/// Posts /// Posts
[<Literal>] [<Literal>]
let Post = "post" let Post = "post"
/// Post Comments /// Post Comments
[<Literal>] [<Literal>]
let PostComment = "post_comment" let PostComment = "post_comment"
/// Post Revisions /// Post Revisions
[<Literal>] [<Literal>]
let PostRevision = "post_revision" let PostRevision = "post_revision"
/// Tag/URL Mappings /// Tag/URL Mappings
[<Literal>] [<Literal>]
let TagMap = "tag_map" let TagMap = "tag_map"
/// Themes /// Themes
[<Literal>] [<Literal>]
let Theme = "theme" let Theme = "theme"
/// Theme Assets /// Theme Assets
[<Literal>] [<Literal>]
let ThemeAsset = "theme_asset" let ThemeAsset = "theme_asset"
/// Uploads /// Uploads
[<Literal>] [<Literal>]
let Upload = "upload" let Upload = "upload"
/// Web Logs /// Web Logs
[<Literal>] [<Literal>]
let WebLog = "web_log" let WebLog = "web_log"
/// Users /// Users
[<Literal>] [<Literal>]
let WebLogUser = "web_log_user" let WebLogUser = "web_log_user"
@ -85,75 +85,75 @@ let maybeInstant =
/// Functions to map domain items from a data reader /// Functions to map domain items from a data reader
module Map = module Map =
open System.IO open System.IO
/// Get a boolean value from a data reader /// Get a boolean value from a data reader
let getBoolean col (rdr: SqliteDataReader) = rdr.GetBoolean(rdr.GetOrdinal col) let getBoolean col (rdr: SqliteDataReader) = rdr.GetBoolean(rdr.GetOrdinal col)
/// Get a date/time value from a data reader /// Get a date/time value from a data reader
let getDateTime col (rdr: SqliteDataReader) = rdr.GetDateTime(rdr.GetOrdinal col) let getDateTime col (rdr: SqliteDataReader) = rdr.GetDateTime(rdr.GetOrdinal col)
/// Get a Guid value from a data reader /// Get a Guid value from a data reader
let getGuid col (rdr: SqliteDataReader) = rdr.GetGuid(rdr.GetOrdinal col) let getGuid col (rdr: SqliteDataReader) = rdr.GetGuid(rdr.GetOrdinal col)
/// Get an int value from a data reader /// Get an int value from a data reader
let getInt col (rdr: SqliteDataReader) = rdr.GetInt32(rdr.GetOrdinal col) let getInt col (rdr: SqliteDataReader) = rdr.GetInt32(rdr.GetOrdinal col)
/// Get a long (64-bit int) value from a data reader /// Get a long (64-bit int) value from a data reader
let getLong col (rdr: SqliteDataReader) = rdr.GetInt64(rdr.GetOrdinal col) let getLong col (rdr: SqliteDataReader) = rdr.GetInt64(rdr.GetOrdinal col)
/// Get a BLOB stream value from a data reader /// Get a BLOB stream value from a data reader
let getStream col (rdr: SqliteDataReader) = rdr.GetStream(rdr.GetOrdinal col) let getStream col (rdr: SqliteDataReader) = rdr.GetStream(rdr.GetOrdinal col)
/// Get a string value from a data reader /// Get a string value from a data reader
let getString col (rdr: SqliteDataReader) = rdr.GetString(rdr.GetOrdinal col) let getString col (rdr: SqliteDataReader) = rdr.GetString(rdr.GetOrdinal col)
/// Parse an Instant from the given value /// Parse an Instant from the given value
let parseInstant value = let parseInstant value =
match InstantPattern.General.Parse value with match InstantPattern.General.Parse value with
| it when it.Success -> it.Value | it when it.Success -> it.Value
| it -> raise it.Exception | it -> raise it.Exception
/// Get an Instant value from a data reader /// Get an Instant value from a data reader
let getInstant col rdr = let getInstant col rdr =
getString col rdr |> parseInstant getString col rdr |> parseInstant
/// Get a timespan value from a data reader /// Get a timespan value from a data reader
let getTimeSpan col (rdr: SqliteDataReader) = rdr.GetTimeSpan(rdr.GetOrdinal col) let getTimeSpan col (rdr: SqliteDataReader) = rdr.GetTimeSpan(rdr.GetOrdinal col)
/// Get a possibly null boolean value from a data reader /// Get a possibly null boolean value from a data reader
let tryBoolean col (rdr: SqliteDataReader) = let tryBoolean col (rdr: SqliteDataReader) =
if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getBoolean col rdr) if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getBoolean col rdr)
/// Get a possibly null date/time value from a data reader /// Get a possibly null date/time value from a data reader
let tryDateTime col (rdr: SqliteDataReader) = let tryDateTime col (rdr: SqliteDataReader) =
if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getDateTime col rdr) if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getDateTime col rdr)
/// Get a possibly null Guid value from a data reader /// Get a possibly null Guid value from a data reader
let tryGuid col (rdr: SqliteDataReader) = let tryGuid col (rdr: SqliteDataReader) =
if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getGuid col rdr) if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getGuid col rdr)
/// Get a possibly null int value from a data reader /// Get a possibly null int value from a data reader
let tryInt col (rdr: SqliteDataReader) = let tryInt col (rdr: SqliteDataReader) =
if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getInt col rdr) if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getInt col rdr)
/// Get a possibly null string value from a data reader /// Get a possibly null string value from a data reader
let tryString col (rdr: SqliteDataReader) = let tryString col (rdr: SqliteDataReader) =
if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getString col rdr) if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getString col rdr)
/// Get a possibly null timespan value from a data reader /// Get a possibly null timespan value from a data reader
let tryTimeSpan col (rdr: SqliteDataReader) = let tryTimeSpan col (rdr: SqliteDataReader) =
if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getTimeSpan col rdr) if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getTimeSpan col rdr)
/// Create a permalink from the current row in the given data reader /// Create a permalink from the current row in the given data reader
let toPermalink rdr = getString "permalink" rdr |> Permalink let toPermalink rdr = getString "permalink" rdr |> Permalink
/// Create a revision from the current row in the given data reader /// Create a revision from the current row in the given data reader
let toRevision rdr : Revision = let toRevision rdr : Revision =
{ AsOf = getInstant "as_of" rdr { AsOf = getInstant "as_of" rdr
Text = getString "revision_text" rdr |> MarkupText.Parse } Text = getString "revision_text" rdr |> MarkupText.Parse }
/// Create a theme asset from the current row in the given data reader /// Create a theme asset from the current row in the given data reader
let toThemeAsset includeData rdr : ThemeAsset = let toThemeAsset includeData rdr : ThemeAsset =
let assetData = let assetData =
@ -167,7 +167,7 @@ module Map =
{ Id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr) { Id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr)
UpdatedOn = getInstant "updated_on" rdr UpdatedOn = getInstant "updated_on" rdr
Data = assetData } Data = assetData }
/// Create an uploaded file from the current row in the given data reader /// Create an uploaded file from the current row in the given data reader
let toUpload includeData rdr : Upload = let toUpload includeData rdr : Upload =
let data = let data =
@ -190,7 +190,7 @@ open BitBadger.Documents
/// Create a named parameter /// Create a named parameter
let sqlParam name (value: obj) = let sqlParam name (value: obj) =
SqliteParameter(name, value) SqliteParameter(name, value)
/// Create a web log ID parameter /// Create a web log ID parameter
let webLogParam (webLogId: WebLogId) = let webLogParam (webLogId: WebLogId) =
sqlParam "@webLogId" (string webLogId) sqlParam "@webLogId" (string webLogId)
@ -205,22 +205,20 @@ let webLogField (webLogId: WebLogId) =
open BitBadger.Documents.Sqlite open BitBadger.Documents.Sqlite
open BitBadger.Documents.Sqlite.WithConn
/// Functions to support revisions /// Functions to support revisions
module Revisions = module Revisions =
/// Find all revisions for the given entity /// Find all revisions for the given entity
let findByEntityId<'TKey> revTable entityTable (key: 'TKey) conn = let findByEntityId<'TKey> revTable entityTable (key: 'TKey) (conn: SqliteConnection) =
Custom.list conn.customList
$"SELECT as_of, revision_text FROM %s{revTable} WHERE %s{entityTable}_id = @id ORDER BY as_of DESC" $"SELECT as_of, revision_text FROM %s{revTable} WHERE %s{entityTable}_id = @id ORDER BY as_of DESC"
[ idParam key ] [ idParam key ]
Map.toRevision Map.toRevision
conn
/// Find all revisions for all posts for the given web log /// Find all revisions for all posts for the given web log
let findByWebLog<'TKey> revTable entityTable (keyFunc: string -> 'TKey) webLogId conn = let findByWebLog<'TKey> revTable entityTable (keyFunc: string -> 'TKey) webLogId (conn: SqliteConnection) =
Custom.list conn.customList
$"SELECT pr.* $"SELECT pr.*
FROM %s{revTable} pr FROM %s{revTable} pr
INNER JOIN %s{entityTable} p ON p.data->>'Id' = pr.{entityTable}_id INNER JOIN %s{entityTable} p ON p.data->>'Id' = pr.{entityTable}_id
@ -228,19 +226,16 @@ module Revisions =
ORDER BY as_of DESC" ORDER BY as_of DESC"
[ webLogParam webLogId ] [ webLogParam webLogId ]
(fun rdr -> keyFunc (Map.getString $"{entityTable}_id" rdr), Map.toRevision rdr) (fun rdr -> keyFunc (Map.getString $"{entityTable}_id" rdr), Map.toRevision rdr)
conn
/// Update a page or post's revisions /// Update a page or post's revisions
let update<'TKey> revTable entityTable (key: 'TKey) oldRevs newRevs conn = backgroundTask { let update<'TKey> revTable entityTable (key: 'TKey) oldRevs newRevs (conn: SqliteConnection) = backgroundTask {
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
for delRev in toDelete do for delRev in toDelete do
do! Custom.nonQuery do! conn.customNonQuery
$"DELETE FROM %s{revTable} WHERE %s{entityTable}_id = @id AND as_of = @asOf" $"DELETE FROM %s{revTable} WHERE %s{entityTable}_id = @id AND as_of = @asOf"
[ idParam key; sqlParam "@asOf" (instantParam delRev.AsOf) ] [ idParam key; sqlParam "@asOf" (instantParam delRev.AsOf) ]
conn
for addRev in toAdd do for addRev in toAdd do
do! Custom.nonQuery do! conn.customNonQuery
$"INSERT INTO {revTable} VALUES (@id, @asOf, @text)" $"INSERT INTO {revTable} VALUES (@id, @asOf, @text)"
[ idParam key; sqlParam "asOf" (instantParam addRev.AsOf); sqlParam "@text" (string addRev.Text) ] [ idParam key; sqlParam "asOf" (instantParam addRev.AsOf); sqlParam "@text" (string addRev.Text) ]
conn
} }

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

@ -7,11 +7,11 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="Markdig" Version="0.37.0" /> <PackageReference Include="Markdig" Version="0.39.1" />
<PackageReference Include="Markdown.ColorCode" Version="2.2.2" /> <PackageReference Include="Markdown.ColorCode" Version="2.3.0" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.3" /> <PackageReference Include="Newtonsoft.Json" Version="13.0.3" />
<PackageReference Include="NodaTime" Version="3.1.12" /> <PackageReference Include="NodaTime" Version="3.2.0" />
<PackageReference Update="FSharp.Core" Version="8.0.400" /> <PackageReference Update="FSharp.Core" Version="9.0.100" />
</ItemGroup> </ItemGroup>
</Project> </Project>

2
src/MyWebLog.Tests/MyWebLog.Tests.fsproj
View File

@ -28,7 +28,7 @@
<ItemGroup> <ItemGroup>
<PackageReference Include="Expecto" Version="10.2.1" /> <PackageReference Include="Expecto" Version="10.2.1" />
<PackageReference Include="ThrowawayDb.Postgres" Version="1.4.0" /> <PackageReference Include="ThrowawayDb.Postgres" Version="1.4.0" />
<PackageReference Update="FSharp.Core" Version="8.0.400" /> <PackageReference Update="FSharp.Core" Version="9.0.100" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>

76
src/MyWebLog/Caches.fs
View File

@ -6,26 +6,26 @@ open MyWebLog.Data
/// Extension properties on HTTP context for web log /// Extension properties on HTTP context for web log
[<AutoOpen>] [<AutoOpen>]
module Extensions = module Extensions =
open System.Security.Claims open System.Security.Claims
open Microsoft.AspNetCore.Antiforgery open Microsoft.AspNetCore.Antiforgery
open Microsoft.Extensions.Configuration open Microsoft.Extensions.Configuration
open Microsoft.Extensions.DependencyInjection open Microsoft.Extensions.DependencyInjection
/// Hold variable for the configured generator string /// Hold variable for the configured generator string
let mutable private generatorString: string option = None let mutable private generatorString: string option = None
type HttpContext with type HttpContext with
/// The anti-CSRF service /// The anti-CSRF service
member this.AntiForgery = this.RequestServices.GetRequiredService<IAntiforgery>() member this.AntiForgery = this.RequestServices.GetRequiredService<IAntiforgery>()
/// The cross-site request forgery token set for this request /// The cross-site request forgery token set for this request
member this.CsrfTokenSet = this.AntiForgery.GetAndStoreTokens this member this.CsrfTokenSet = this.AntiForgery.GetAndStoreTokens this
/// The data implementation /// The data implementation
member this.Data = this.RequestServices.GetRequiredService<IData>() member this.Data = this.RequestServices.GetRequiredService<IData>()
/// The generator string /// The generator string
member this.Generator = member this.Generator =
match generatorString with match generatorString with
@ -50,7 +50,7 @@ module Extensions =
/// The web log for the current request /// The web log for the current request
member this.WebLog = this.Items["webLog"] :?> WebLog member this.WebLog = this.Items["webLog"] :?> WebLog
/// Does the current user have the requested level of access? /// Does the current user have the requested level of access?
member this.HasAccessLevel level = member this.HasAccessLevel level =
defaultArg (this.UserAccessLevel |> Option.map _.HasAccess(level)) false defaultArg (this.UserAccessLevel |> Option.map _.HasAccess(level)) false
@ -64,21 +64,21 @@ open System.Collections.Concurrent
/// <remarks>This is filled by the middleware via the first request for each host, and can be updated via the web log /// <remarks>This is filled by the middleware via the first request for each host, and can be updated via the web log
/// settings update page</remarks> /// settings update page</remarks>
module WebLogCache = module WebLogCache =
open System.Text.RegularExpressions open System.Text.RegularExpressions
/// A redirect rule that caches compiled regular expression rules /// A redirect rule that caches compiled regular expression rules
type CachedRedirectRule = type CachedRedirectRule =
/// A straight text match rule /// A straight text match rule
| Text of string * string | Text of string * string
/// A regular expression match rule /// A regular expression match rule
| RegEx of Regex * string | RegEx of Regex * string
/// The cache of web log details /// The cache of web log details
let mutable private _cache : WebLog list = [] let mutable private _cache: WebLog list = []
/// Redirect rules with compiled regular expressions /// Redirect rules with compiled regular expressions
let mutable private _redirectCache = ConcurrentDictionary<WebLogId, CachedRedirectRule list> () let mutable private _redirectCache = ConcurrentDictionary<WebLogId, CachedRedirectRule list>()
/// Try to get the web log for the current request (longest matching URL base wins) /// Try to get the web log for the current request (longest matching URL base wins)
let tryGet (path : string) = let tryGet (path : string) =
@ -100,21 +100,21 @@ module WebLogCache =
RegEx(Regex(pattern, RegexOptions.Compiled ||| RegexOptions.IgnoreCase), urlTo) RegEx(Regex(pattern, RegexOptions.Compiled ||| RegexOptions.IgnoreCase), urlTo)
else else
Text(relUrl it.From, urlTo)) Text(relUrl it.From, urlTo))
/// Get all cached web logs /// Get all cached web logs
let all () = let all () =
_cache _cache
/// Fill the web log cache from the database /// Fill the web log cache from the database
let fill (data: IData) = backgroundTask { let fill (data: IData) = backgroundTask {
let! webLogs = data.WebLog.All() let! webLogs = data.WebLog.All()
webLogs |> List.iter set webLogs |> List.iter set
} }
/// Get the cached redirect rules for the given web log /// Get the cached redirect rules for the given web log
let redirectRules webLogId = let redirectRules webLogId =
_redirectCache[webLogId] _redirectCache[webLogId]
/// Is the given theme in use by any web logs? /// Is the given theme in use by any web logs?
let isThemeInUse themeId = let isThemeInUse themeId =
_cache |> List.exists (fun wl -> wl.ThemeId = themeId) _cache |> List.exists (fun wl -> wl.ThemeId = themeId)
@ -122,30 +122,30 @@ module WebLogCache =
/// A cache of page information needed to display the page list in templates /// A cache of page information needed to display the page list in templates
module PageListCache = module PageListCache =
open MyWebLog.ViewModels open MyWebLog.ViewModels
/// Cache of displayed pages /// Cache of displayed pages
let private _cache = ConcurrentDictionary<WebLogId, DisplayPage array> () let private _cache = ConcurrentDictionary<WebLogId, DisplayPage array>()
let private fillPages (webLog: WebLog) pages = let private fillPages (webLog: WebLog) pages =
_cache[webLog.Id] <- _cache[webLog.Id] <-
pages pages
|> List.map (fun pg -> DisplayPage.FromPage webLog { pg with Text = "" }) |> List.map (fun pg -> DisplayPage.FromPage webLog { pg with Text = "" })
|> Array.ofList |> Array.ofList
/// Are there pages cached for this web log? /// Are there pages cached for this web log?
let exists (ctx: HttpContext) = _cache.ContainsKey ctx.WebLog.Id let exists (ctx: HttpContext) = _cache.ContainsKey ctx.WebLog.Id
/// Get the pages for the web log for this request /// Get the pages for the web log for this request
let get (ctx: HttpContext) = _cache[ctx.WebLog.Id] let get (ctx: HttpContext) = _cache[ctx.WebLog.Id]
/// Update the pages for the current web log /// Update the pages for the current web log
let update (ctx: HttpContext) = backgroundTask { let update (ctx: HttpContext) = backgroundTask {
let! pages = ctx.Data.Page.FindListed ctx.WebLog.Id let! pages = ctx.Data.Page.FindListed ctx.WebLog.Id
fillPages ctx.WebLog pages fillPages ctx.WebLog pages
} }
/// Refresh the pages for the given web log /// Refresh the pages for the given web log
let refresh (webLog: WebLog) (data: IData) = backgroundTask { let refresh (webLog: WebLog) (data: IData) = backgroundTask {
let! pages = data.Page.FindListed webLog.Id let! pages = data.Page.FindListed webLog.Id
@ -155,24 +155,24 @@ module PageListCache =
/// Cache of all categories, indexed by web log /// Cache of all categories, indexed by web log
module CategoryCache = module CategoryCache =
open MyWebLog.ViewModels open MyWebLog.ViewModels
/// The cache itself /// The cache itself
let private _cache = ConcurrentDictionary<WebLogId, DisplayCategory array> () let private _cache = ConcurrentDictionary<WebLogId, DisplayCategory array>()
/// Are there categories cached for this web log? /// Are there categories cached for this web log?
let exists (ctx: HttpContext) = _cache.ContainsKey ctx.WebLog.Id let exists (ctx: HttpContext) = _cache.ContainsKey ctx.WebLog.Id
/// Get the categories for the web log for this request /// Get the categories for the web log for this request
let get (ctx: HttpContext) = _cache[ctx.WebLog.Id] let get (ctx: HttpContext) = _cache[ctx.WebLog.Id]
/// Update the cache with fresh data /// Update the cache with fresh data
let update (ctx: HttpContext) = backgroundTask { let update (ctx: HttpContext) = backgroundTask {
let! cats = ctx.Data.Category.FindAllForView ctx.WebLog.Id let! cats = ctx.Data.Category.FindAllForView ctx.WebLog.Id
_cache[ctx.WebLog.Id] <- cats _cache[ctx.WebLog.Id] <- cats
} }
/// Refresh the category cache for the given web log /// Refresh the category cache for the given web log
let refresh webLogId (data: IData) = backgroundTask { let refresh webLogId (data: IData) = backgroundTask {
let! cats = data.Category.FindAllForView webLogId let! cats = data.Category.FindAllForView webLogId
@ -182,19 +182,19 @@ module CategoryCache =
/// A cache of asset names by themes /// A cache of asset names by themes
module ThemeAssetCache = module ThemeAssetCache =
/// A list of asset names for each theme /// A list of asset names for each theme
let private _cache = ConcurrentDictionary<ThemeId, string list> () let private _cache = ConcurrentDictionary<ThemeId, string list>()
/// Retrieve the assets for the given theme ID /// Retrieve the assets for the given theme ID
let get themeId = _cache[themeId] let get themeId = _cache[themeId]
/// Refresh the list of assets for the given theme /// Refresh the list of assets for the given theme
let refreshTheme themeId (data: IData) = backgroundTask { let refreshTheme themeId (data: IData) = backgroundTask {
let! assets = data.ThemeAsset.FindByTheme themeId let! assets = data.ThemeAsset.FindByTheme themeId
_cache[themeId] <- assets |> List.map (fun a -> match a.Id with ThemeAssetId (_, path) -> path) _cache[themeId] <- assets |> List.map (fun a -> match a.Id with ThemeAssetId (_, path) -> path)
} }
/// Fill the theme asset cache /// Fill the theme asset cache
let fill (data: IData) = backgroundTask { let fill (data: IData) = backgroundTask {
let! assets = data.ThemeAsset.All() let! assets = data.ThemeAsset.All()

16
src/MyWebLog/MyWebLog.fsproj
View File

@ -31,16 +31,16 @@
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="BitBadger.AspNetCore.CanonicalDomains" Version="1.0.0" /> <PackageReference Include="BitBadger.AspNetCore.CanonicalDomains" Version="1.1.0" />
<PackageReference Include="DotLiquid" Version="2.2.692" /> <PackageReference Include="DotLiquid" Version="2.2.692" />
<PackageReference Include="Fluid.Core" Version="2.11.1" /> <PackageReference Include="Fluid.Core" Version="2.16.0" />
<PackageReference Include="Giraffe" Version="6.4.0" /> <PackageReference Include="Giraffe" Version="7.0.2" />
<PackageReference Include="Giraffe.Htmx" Version="2.0.2" /> <PackageReference Include="Giraffe.Htmx" Version="2.0.4" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="2.0.2" /> <PackageReference Include="Giraffe.ViewEngine.Htmx" Version="2.0.4" />
<PackageReference Include="NeoSmart.Caching.Sqlite.AspNetCore" Version="8.0.0" /> <PackageReference Include="NeoSmart.Caching.Sqlite.AspNetCore" Version="9.0.0" />
<PackageReference Include="RethinkDB.DistributedCache" Version="1.0.0-rc1" /> <PackageReference Include="RethinkDB.DistributedCache" Version="1.0.0-rc1" />
<PackageReference Include="System.ServiceModel.Syndication" Version="8.0.0" /> <PackageReference Include="System.ServiceModel.Syndication" Version="9.0.0" />
<PackageReference Update="FSharp.Core" Version="8.0.400" /> <PackageReference Update="FSharp.Core" Version="9.0.100" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>

40
src/MyWebLog/Program.fs
View File

@ -6,10 +6,10 @@ open MyWebLog
/// Middleware to derive the current web log /// Middleware to derive the current web log
type WebLogMiddleware(next: RequestDelegate, log: ILogger<WebLogMiddleware>) = 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 _.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}"
@ -32,7 +32,7 @@ type RedirectRuleMiddleware(next: RequestDelegate, _log: ILogger<RedirectRuleMid
/// Shorthand for case-insensitive string equality /// Shorthand for case-insensitive string equality
let ciEquals str1 str2 = let ciEquals str1 str2 =
System.String.Equals(str1, str2, System.StringComparison.InvariantCultureIgnoreCase) System.String.Equals(str1, str2, System.StringComparison.InvariantCultureIgnoreCase)
member _.InvokeAsync(ctx: HttpContext) = task { member _.InvokeAsync(ctx: HttpContext) = task {
let path = ctx.Request.Path.Value.ToLower() let path = ctx.Request.Path.Value.ToLower()
let matched = let matched =
@ -59,11 +59,11 @@ open Npgsql
/// Logic to obtain a data connection and implementation based on configured values /// Logic to obtain a data connection and implementation based on configured values
module DataImplementation = module DataImplementation =
open MyWebLog.Converters open MyWebLog.Converters
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 /// Create an NpgsqlDataSource from the connection string, configuring appropriately
let createNpgsqlDataSource (cfg: IConfiguration) = let createNpgsqlDataSource (cfg: IConfiguration) =
let builder = NpgsqlDataSourceBuilder(cfg.GetConnectionString "PostgreSQL") let builder = NpgsqlDataSourceBuilder(cfg.GetConnectionString "PostgreSQL")
@ -83,12 +83,12 @@ module DataImplementation =
let conn = Sqlite.Configuration.dbConn () let conn = Sqlite.Configuration.dbConn ()
log.LogInformation $"Using SQLite database {conn.DataSource}" log.LogInformation $"Using SQLite database {conn.DataSource}"
SQLiteData(conn, log, Json.configure (JsonSerializer.CreateDefault())) SQLiteData(conn, log, Json.configure (JsonSerializer.CreateDefault()))
if hasConnStr "SQLite" then if hasConnStr "SQLite" then
createSQLite (connStr "SQLite") createSQLite (connStr "SQLite")
elif hasConnStr "RethinkDB" then elif hasConnStr "RethinkDB" then
let log = sp.GetRequiredService<ILogger<RethinkDbData>>() let log = sp.GetRequiredService<ILogger<RethinkDbData>>()
let _ = Json.configure Converter.Serializer let _ = Json.configure Converter.Serializer
let rethinkCfg = DataConfig.FromUri (connStr "RethinkDB") let rethinkCfg = DataConfig.FromUri (connStr "RethinkDB")
let conn = await (rethinkCfg.CreateConnectionAsync log) let conn = await (rethinkCfg.CreateConnectionAsync log)
RethinkDbData(conn, rethinkCfg, log) RethinkDbData(conn, rethinkCfg, log)
@ -131,7 +131,7 @@ open Microsoft.AspNetCore.Authentication.Cookies
open Microsoft.AspNetCore.Builder open Microsoft.AspNetCore.Builder
open Microsoft.AspNetCore.HttpOverrides open Microsoft.AspNetCore.HttpOverrides
open Microsoft.Extensions.Caching.Distributed open Microsoft.Extensions.Caching.Distributed
open NeoSmart.Caching.Sqlite.AspNetCore open NeoSmart.Caching.Sqlite
open RethinkDB.DistributedCache open RethinkDB.DistributedCache
[<EntryPoint>] [<EntryPoint>]
@ -140,7 +140,7 @@ let main args =
let builder = WebApplication.CreateBuilder(args) let builder = WebApplication.CreateBuilder(args)
let _ = builder.Services.Configure<ForwardedHeadersOptions>(fun (opts : ForwardedHeadersOptions) -> let _ = builder.Services.Configure<ForwardedHeadersOptions>(fun (opts : ForwardedHeadersOptions) ->
opts.ForwardedHeaders <- ForwardedHeaders.XForwardedFor ||| ForwardedHeaders.XForwardedProto) opts.ForwardedHeaders <- ForwardedHeaders.XForwardedFor ||| ForwardedHeaders.XForwardedProto)
let _ = let _ =
builder.Services builder.Services
.AddAuthentication(CookieAuthenticationDefaults.AuthenticationScheme) .AddAuthentication(CookieAuthenticationDefaults.AuthenticationScheme)
.AddCookie(fun opts -> .AddCookie(fun opts ->
@ -150,17 +150,17 @@ let main args =
let _ = builder.Services.AddLogging() let _ = builder.Services.AddLogging()
let _ = builder.Services.AddAuthorization() let _ = builder.Services.AddAuthorization()
let _ = builder.Services.AddAntiforgery() let _ = builder.Services.AddAntiforgery()
let sp = builder.Services.BuildServiceProvider() let sp = builder.Services.BuildServiceProvider()
let data = DataImplementation.get sp let data = DataImplementation.get sp
let _ = builder.Services.AddSingleton<JsonSerializer> data.Serializer let _ = builder.Services.AddSingleton<JsonSerializer> data.Serializer
task { task {
do! data.StartUp() do! data.StartUp()
do! WebLogCache.fill data do! WebLogCache.fill data
do! ThemeAssetCache.fill data do! ThemeAssetCache.fill data
} |> Async.AwaitTask |> Async.RunSynchronously } |> Async.AwaitTask |> Async.RunSynchronously
// Define distributed cache implementation based on data implementation // Define distributed cache implementation based on data implementation
match data with match data with
| :? RethinkDbData as rethink -> | :? RethinkDbData as rethink ->
@ -189,18 +189,18 @@ let main args =
Postgres.DistributedCache() :> IDistributedCache) Postgres.DistributedCache() :> IDistributedCache)
() ()
| _ -> () | _ -> ()
let _ = builder.Services.AddSession(fun opts -> let _ = builder.Services.AddSession(fun opts ->
opts.IdleTimeout <- TimeSpan.FromMinutes 60 opts.IdleTimeout <- TimeSpan.FromMinutes 60.
opts.Cookie.HttpOnly <- true opts.Cookie.HttpOnly <- true
opts.Cookie.IsEssential <- true) opts.Cookie.IsEssential <- true)
let _ = builder.Services.AddGiraffe() let _ = builder.Services.AddGiraffe()
// Set up DotLiquid // Set up DotLiquid
DotLiquidBespoke.register () DotLiquidBespoke.register ()
let app = builder.Build() let app = builder.Build()
match args |> Array.tryHead with match args |> Array.tryHead with
| Some it when it = "init" -> Maintenance.createWebLog args app.Services | Some it when it = "init" -> Maintenance.createWebLog args app.Services
| Some it when it = "import-links" -> Maintenance.importLinks args app.Services | Some it when it = "import-links" -> Maintenance.importLinks args app.Services
@ -222,13 +222,13 @@ let main args =
if Directory.Exists themePath then if Directory.Exists themePath then
for themeFile in Directory.EnumerateFiles(themePath, "*-theme.zip") do for themeFile in Directory.EnumerateFiles(themePath, "*-theme.zip") do
do! Maintenance.loadTheme [| ""; themeFile |] app.Services do! Maintenance.loadTheme [| ""; themeFile |] app.Services
let _ = app.UseForwardedHeaders() let _ = app.UseForwardedHeaders()
(app.Services.GetRequiredService<IConfiguration>().GetSection "CanonicalDomains").Value (app.Services.GetRequiredService<IConfiguration>().GetSection "CanonicalDomains").Value
|> (isNull >> not) |> (isNull >> not)
|> function true -> app.UseCanonicalDomains() |> ignore | false -> () |> function true -> app.UseCanonicalDomains() |> ignore | false -> ()
let _ = app.UseCookiePolicy(CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict)) let _ = app.UseCookiePolicy(CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict))
let _ = app.UseMiddleware<WebLogMiddleware>() let _ = app.UseMiddleware<WebLogMiddleware>()
let _ = app.UseMiddleware<RedirectRuleMiddleware>() let _ = app.UseMiddleware<RedirectRuleMiddleware>()
@ -241,5 +241,5 @@ let main args =
app.Run() app.Run()
} }
|> Async.AwaitTask |> Async.RunSynchronously |> Async.AwaitTask |> Async.RunSynchronously
0 // Exit code 0 // Exit code

4
src/MyWebLog/appsettings.json
View File

@ -1,4 +1,4 @@
{ {
"Generator": "myWebLog 3", "Generator": "myWebLog 3",
"Logging": { "Logging": {
"LogLevel": { "LogLevel": {
@ -8,7 +8,7 @@
"Kestrel": { "Kestrel": {
"Endpoints": { "Endpoints": {
"Http": { "Http": {
"Url": "http://0.0.0.0:80" "Url": "http://0.0.0.0:5000"
} }
} }
} }