diff --git a/build.fs b/build.fs index 0e9eb60..68c670a 100644 --- a/build.fs +++ b/build.fs @@ -23,7 +23,7 @@ let version = 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" @@ -33,9 +33,9 @@ let zipTheme (name : string) (_ : TargetParameter) = |> Zip.zipSpec $"{releasePath}/{name}-theme.zip" /// 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) = frameworks |> List.iter (fun fwk -> @@ -65,7 +65,7 @@ let packageFor rid (_ : TargetParameter) = Target.create "Clean" (fun _ -> !! "src/**/bin" ++ "src/**/obj" - |> Shell.cleanDirs + |> Shell.cleanDirs Shell.cleanDir releasePath ) @@ -87,7 +87,7 @@ Target.create "RepackageLinux" (fun _ -> frameworks |> List.iter (fun fwk -> let zipArchive = $"{releasePath}/myWebLog-{version}.{fwk}.linux-x64.zip" - let sh command args = + let sh command args = CreateProcess.fromRawCommand command args |> CreateProcess.redirectOutput |> Proc.run diff --git a/src/Directory.Build.props b/src/Directory.Build.props index c9977df..2b3671f 100644 --- a/src/Directory.Build.props +++ b/src/Directory.Build.props @@ -1,9 +1,10 @@ - net6.0;net8.0 + net8.0;net9.0 embedded - 2.2.0.0 - 2.2.0.0 - 2.2.0 + 3.0.0.0 + 3.0.0.0 + 3.0.0 + beta1 diff --git a/src/MyWebLog.Data/MyWebLog.Data.fsproj b/src/MyWebLog.Data/MyWebLog.Data.fsproj index 43f2e0c..f68009e 100644 --- a/src/MyWebLog.Data/MyWebLog.Data.fsproj +++ b/src/MyWebLog.Data/MyWebLog.Data.fsproj @@ -5,17 +5,17 @@ - - - - - + + + + + - + - + diff --git a/src/MyWebLog.Data/SQLite/SQLiteHelpers.fs b/src/MyWebLog.Data/SQLite/SQLiteHelpers.fs index 13e90e8..90a1978 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteHelpers.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteHelpers.fs @@ -5,55 +5,55 @@ module MyWebLog.Data.SQLite.SQLiteHelpers /// The table names used in the SQLite implementation [] module Table = - + /// Categories [] let Category = "category" - + /// Database Version [] let DbVersion = "db_version" - + /// Pages [] let Page = "page" - + /// Page Revisions [] let PageRevision = "page_revision" - + /// Posts [] let Post = "post" - + /// Post Comments [] let PostComment = "post_comment" - + /// Post Revisions [] let PostRevision = "post_revision" - + /// Tag/URL Mappings [] let TagMap = "tag_map" - + /// Themes [] let Theme = "theme" - + /// Theme Assets [] let ThemeAsset = "theme_asset" - + /// Uploads [] let Upload = "upload" - + /// Web Logs [] let WebLog = "web_log" - + /// Users [] let WebLogUser = "web_log_user" @@ -85,75 +85,75 @@ let maybeInstant = /// Functions to map domain items from a data reader module Map = - + open System.IO - + /// Get a boolean value from a data reader let getBoolean col (rdr: SqliteDataReader) = rdr.GetBoolean(rdr.GetOrdinal col) - + /// Get a date/time value from a data reader let getDateTime col (rdr: SqliteDataReader) = rdr.GetDateTime(rdr.GetOrdinal col) - + /// Get a Guid value from a data reader let getGuid col (rdr: SqliteDataReader) = rdr.GetGuid(rdr.GetOrdinal col) - + /// Get an int value from a data reader let getInt col (rdr: SqliteDataReader) = rdr.GetInt32(rdr.GetOrdinal col) - + /// Get a long (64-bit int) value from a data reader let getLong col (rdr: SqliteDataReader) = rdr.GetInt64(rdr.GetOrdinal col) - + /// Get a BLOB stream value from a data reader let getStream col (rdr: SqliteDataReader) = rdr.GetStream(rdr.GetOrdinal col) - + /// Get a string value from a data reader let getString col (rdr: SqliteDataReader) = rdr.GetString(rdr.GetOrdinal col) - + /// Parse an Instant from the given value let parseInstant value = match InstantPattern.General.Parse value with | it when it.Success -> it.Value | it -> raise it.Exception - + /// Get an Instant value from a data reader let getInstant col rdr = getString col rdr |> parseInstant - + /// Get a timespan value from a data reader let getTimeSpan col (rdr: SqliteDataReader) = rdr.GetTimeSpan(rdr.GetOrdinal col) - + /// Get a possibly null boolean value from a data reader let tryBoolean col (rdr: SqliteDataReader) = if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getBoolean col rdr) - + /// Get a possibly null date/time value from a data reader let tryDateTime col (rdr: SqliteDataReader) = if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getDateTime col rdr) - + /// Get a possibly null Guid value from a data reader let tryGuid col (rdr: SqliteDataReader) = if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getGuid col rdr) - + /// Get a possibly null int value from a data reader let tryInt col (rdr: SqliteDataReader) = if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getInt col rdr) - + /// Get a possibly null string value from a data reader let tryString col (rdr: SqliteDataReader) = if rdr.IsDBNull(rdr.GetOrdinal col) then None else Some (getString col rdr) - + /// Get a possibly null timespan value from a data reader let tryTimeSpan col (rdr: SqliteDataReader) = 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 let toPermalink rdr = getString "permalink" rdr |> Permalink - + /// Create a revision from the current row in the given data reader let toRevision rdr : Revision = { AsOf = getInstant "as_of" rdr Text = getString "revision_text" rdr |> MarkupText.Parse } - + /// Create a theme asset from the current row in the given data reader let toThemeAsset includeData rdr : ThemeAsset = let assetData = @@ -167,7 +167,7 @@ module Map = { Id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr) UpdatedOn = getInstant "updated_on" rdr Data = assetData } - + /// Create an uploaded file from the current row in the given data reader let toUpload includeData rdr : Upload = let data = @@ -190,7 +190,7 @@ open BitBadger.Documents /// Create a named parameter let sqlParam name (value: obj) = SqliteParameter(name, value) - + /// Create a web log ID parameter let webLogParam (webLogId: WebLogId) = sqlParam "@webLogId" (string webLogId) @@ -205,22 +205,20 @@ let webLogField (webLogId: WebLogId) = open BitBadger.Documents.Sqlite -open BitBadger.Documents.Sqlite.WithConn /// Functions to support revisions module Revisions = - + /// Find all revisions for the given entity - let findByEntityId<'TKey> revTable entityTable (key: 'TKey) conn = - Custom.list + let findByEntityId<'TKey> revTable entityTable (key: 'TKey) (conn: SqliteConnection) = + conn.customList $"SELECT as_of, revision_text FROM %s{revTable} WHERE %s{entityTable}_id = @id ORDER BY as_of DESC" [ idParam key ] Map.toRevision - conn - + /// Find all revisions for all posts for the given web log - let findByWebLog<'TKey> revTable entityTable (keyFunc: string -> 'TKey) webLogId conn = - Custom.list + let findByWebLog<'TKey> revTable entityTable (keyFunc: string -> 'TKey) webLogId (conn: SqliteConnection) = + conn.customList $"SELECT pr.* FROM %s{revTable} pr INNER JOIN %s{entityTable} p ON p.data->>'Id' = pr.{entityTable}_id @@ -228,19 +226,16 @@ module Revisions = ORDER BY as_of DESC" [ webLogParam webLogId ] (fun rdr -> keyFunc (Map.getString $"{entityTable}_id" rdr), Map.toRevision rdr) - conn /// 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 for delRev in toDelete do - do! Custom.nonQuery + do! conn.customNonQuery $"DELETE FROM %s{revTable} WHERE %s{entityTable}_id = @id AND as_of = @asOf" [ idParam key; sqlParam "@asOf" (instantParam delRev.AsOf) ] - conn for addRev in toAdd do - do! Custom.nonQuery + do! conn.customNonQuery $"INSERT INTO {revTable} VALUES (@id, @asOf, @text)" [ idParam key; sqlParam "asOf" (instantParam addRev.AsOf); sqlParam "@text" (string addRev.Text) ] - conn } diff --git a/src/MyWebLog.Domain/MyWebLog.Domain.fsproj b/src/MyWebLog.Domain/MyWebLog.Domain.fsproj index 8e647aa..489ff15 100644 --- a/src/MyWebLog.Domain/MyWebLog.Domain.fsproj +++ b/src/MyWebLog.Domain/MyWebLog.Domain.fsproj @@ -7,11 +7,11 @@ - - + + - - + + diff --git a/src/MyWebLog.Tests/MyWebLog.Tests.fsproj b/src/MyWebLog.Tests/MyWebLog.Tests.fsproj index fd362a3..64b9795 100644 --- a/src/MyWebLog.Tests/MyWebLog.Tests.fsproj +++ b/src/MyWebLog.Tests/MyWebLog.Tests.fsproj @@ -28,7 +28,7 @@ - + diff --git a/src/MyWebLog/Caches.fs b/src/MyWebLog/Caches.fs index 0c141de..4beb388 100644 --- a/src/MyWebLog/Caches.fs +++ b/src/MyWebLog/Caches.fs @@ -6,26 +6,26 @@ open MyWebLog.Data /// Extension properties on HTTP context for web log [] module Extensions = - + open System.Security.Claims open Microsoft.AspNetCore.Antiforgery open Microsoft.Extensions.Configuration open Microsoft.Extensions.DependencyInjection - + /// Hold variable for the configured generator string let mutable private generatorString: string option = None - + type HttpContext with - + /// The anti-CSRF service member this.AntiForgery = this.RequestServices.GetRequiredService() - + /// The cross-site request forgery token set for this request member this.CsrfTokenSet = this.AntiForgery.GetAndStoreTokens this /// The data implementation member this.Data = this.RequestServices.GetRequiredService() - + /// The generator string member this.Generator = match generatorString with @@ -50,7 +50,7 @@ module Extensions = /// The web log for the current request member this.WebLog = this.Items["webLog"] :?> WebLog - + /// Does the current user have the requested level of access? member this.HasAccessLevel level = defaultArg (this.UserAccessLevel |> Option.map _.HasAccess(level)) false @@ -64,21 +64,21 @@ open System.Collections.Concurrent /// This is filled by the middleware via the first request for each host, and can be updated via the web log /// settings update page module WebLogCache = - + open System.Text.RegularExpressions /// A redirect rule that caches compiled regular expression rules type CachedRedirectRule = - /// A straight text match rule - | Text of string * string - /// A regular expression match rule - | RegEx of Regex * string + /// A straight text match rule + | Text of string * string + /// A regular expression match rule + | RegEx of Regex * string /// The cache of web log details - let mutable private _cache : WebLog list = [] + let mutable private _cache: WebLog list = [] /// Redirect rules with compiled regular expressions - let mutable private _redirectCache = ConcurrentDictionary () + let mutable private _redirectCache = ConcurrentDictionary() /// Try to get the web log for the current request (longest matching URL base wins) let tryGet (path : string) = @@ -100,21 +100,21 @@ module WebLogCache = RegEx(Regex(pattern, RegexOptions.Compiled ||| RegexOptions.IgnoreCase), urlTo) else Text(relUrl it.From, urlTo)) - + /// Get all cached web logs let all () = _cache - + /// Fill the web log cache from the database let fill (data: IData) = backgroundTask { let! webLogs = data.WebLog.All() webLogs |> List.iter set } - + /// Get the cached redirect rules for the given web log let redirectRules webLogId = _redirectCache[webLogId] - + /// Is the given theme in use by any web logs? let isThemeInUse 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 module PageListCache = - + open MyWebLog.ViewModels - + /// Cache of displayed pages - let private _cache = ConcurrentDictionary () - + let private _cache = ConcurrentDictionary() + let private fillPages (webLog: WebLog) pages = _cache[webLog.Id] <- pages |> List.map (fun pg -> DisplayPage.FromPage webLog { pg with Text = "" }) |> Array.ofList - + /// Are there pages cached for this web log? let exists (ctx: HttpContext) = _cache.ContainsKey ctx.WebLog.Id - + /// Get the pages for the web log for this request let get (ctx: HttpContext) = _cache[ctx.WebLog.Id] - + /// Update the pages for the current web log let update (ctx: HttpContext) = backgroundTask { let! pages = ctx.Data.Page.FindListed ctx.WebLog.Id fillPages ctx.WebLog pages } - + /// Refresh the pages for the given web log let refresh (webLog: WebLog) (data: IData) = backgroundTask { let! pages = data.Page.FindListed webLog.Id @@ -155,24 +155,24 @@ module PageListCache = /// Cache of all categories, indexed by web log module CategoryCache = - + open MyWebLog.ViewModels - + /// The cache itself - let private _cache = ConcurrentDictionary () - + let private _cache = ConcurrentDictionary() + /// Are there categories cached for this web log? let exists (ctx: HttpContext) = _cache.ContainsKey ctx.WebLog.Id - + /// Get the categories for the web log for this request let get (ctx: HttpContext) = _cache[ctx.WebLog.Id] - + /// Update the cache with fresh data let update (ctx: HttpContext) = backgroundTask { let! cats = ctx.Data.Category.FindAllForView ctx.WebLog.Id _cache[ctx.WebLog.Id] <- cats } - + /// Refresh the category cache for the given web log let refresh webLogId (data: IData) = backgroundTask { let! cats = data.Category.FindAllForView webLogId @@ -182,19 +182,19 @@ module CategoryCache = /// A cache of asset names by themes module ThemeAssetCache = - + /// A list of asset names for each theme - let private _cache = ConcurrentDictionary () - + let private _cache = ConcurrentDictionary() + /// Retrieve the assets for the given theme ID let get themeId = _cache[themeId] - + /// Refresh the list of assets for the given theme let refreshTheme themeId (data: IData) = backgroundTask { let! assets = data.ThemeAsset.FindByTheme themeId _cache[themeId] <- assets |> List.map (fun a -> match a.Id with ThemeAssetId (_, path) -> path) } - + /// Fill the theme asset cache let fill (data: IData) = backgroundTask { let! assets = data.ThemeAsset.All() diff --git a/src/MyWebLog/MyWebLog.fsproj b/src/MyWebLog/MyWebLog.fsproj index c51435d..42064ea 100644 --- a/src/MyWebLog/MyWebLog.fsproj +++ b/src/MyWebLog/MyWebLog.fsproj @@ -31,16 +31,16 @@ - + - - - - - + + + + + - - + + diff --git a/src/MyWebLog/Program.fs b/src/MyWebLog/Program.fs index 579909e..59fbfa6 100644 --- a/src/MyWebLog/Program.fs +++ b/src/MyWebLog/Program.fs @@ -6,10 +6,10 @@ open MyWebLog /// Middleware to derive the current web log type WebLogMiddleware(next: RequestDelegate, log: ILogger) = - + /// Is the debug level enabled on the logger? let isDebug = log.IsEnabled LogLevel.Debug - + member _.InvokeAsync(ctx: HttpContext) = task { /// Create the full path of the request let path = $"{ctx.Request.Scheme}://{ctx.Request.Host.Value}{ctx.Request.Path.Value}" @@ -32,7 +32,7 @@ type RedirectRuleMiddleware(next: RequestDelegate, _log: ILogger>() - let _ = Json.configure Converter.Serializer + let _ = Json.configure Converter.Serializer let rethinkCfg = DataConfig.FromUri (connStr "RethinkDB") let conn = await (rethinkCfg.CreateConnectionAsync log) RethinkDbData(conn, rethinkCfg, log) @@ -131,7 +131,7 @@ open Microsoft.AspNetCore.Authentication.Cookies open Microsoft.AspNetCore.Builder open Microsoft.AspNetCore.HttpOverrides open Microsoft.Extensions.Caching.Distributed -open NeoSmart.Caching.Sqlite.AspNetCore +open NeoSmart.Caching.Sqlite open RethinkDB.DistributedCache [] @@ -140,7 +140,7 @@ let main args = let builder = WebApplication.CreateBuilder(args) let _ = builder.Services.Configure(fun (opts : ForwardedHeadersOptions) -> opts.ForwardedHeaders <- ForwardedHeaders.XForwardedFor ||| ForwardedHeaders.XForwardedProto) - let _ = + let _ = builder.Services .AddAuthentication(CookieAuthenticationDefaults.AuthenticationScheme) .AddCookie(fun opts -> @@ -150,17 +150,17 @@ let main args = let _ = builder.Services.AddLogging() let _ = builder.Services.AddAuthorization() let _ = builder.Services.AddAntiforgery() - + let sp = builder.Services.BuildServiceProvider() let data = DataImplementation.get sp let _ = builder.Services.AddSingleton data.Serializer - + task { do! data.StartUp() do! WebLogCache.fill data do! ThemeAssetCache.fill data } |> Async.AwaitTask |> Async.RunSynchronously - + // Define distributed cache implementation based on data implementation match data with | :? RethinkDbData as rethink -> @@ -189,18 +189,18 @@ let main args = Postgres.DistributedCache() :> IDistributedCache) () | _ -> () - + let _ = builder.Services.AddSession(fun opts -> - opts.IdleTimeout <- TimeSpan.FromMinutes 60 + opts.IdleTimeout <- TimeSpan.FromMinutes 60. opts.Cookie.HttpOnly <- true opts.Cookie.IsEssential <- true) let _ = builder.Services.AddGiraffe() - + // Set up DotLiquid DotLiquidBespoke.register () let app = builder.Build() - + match args |> Array.tryHead with | Some it when it = "init" -> Maintenance.createWebLog 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 for themeFile in Directory.EnumerateFiles(themePath, "*-theme.zip") do do! Maintenance.loadTheme [| ""; themeFile |] app.Services - + let _ = app.UseForwardedHeaders() - + (app.Services.GetRequiredService().GetSection "CanonicalDomains").Value |> (isNull >> not) |> function true -> app.UseCanonicalDomains() |> ignore | false -> () - + let _ = app.UseCookiePolicy(CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict)) let _ = app.UseMiddleware() let _ = app.UseMiddleware() @@ -241,5 +241,5 @@ let main args = app.Run() } |> Async.AwaitTask |> Async.RunSynchronously - + 0 // Exit code diff --git a/src/MyWebLog/appsettings.json b/src/MyWebLog/appsettings.json index 3c2eae7..4d980d8 100644 --- a/src/MyWebLog/appsettings.json +++ b/src/MyWebLog/appsettings.json @@ -1,4 +1,4 @@ -{ +{ "Generator": "myWebLog 3", "Logging": { "LogLevel": { @@ -8,7 +8,7 @@ "Kestrel": { "Endpoints": { "Http": { - "Url": "http://0.0.0.0:80" + "Url": "http://0.0.0.0:5000" } } }