From cb02055d875959590686248bacce659948054ed9 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Sat, 16 Dec 2023 20:38:37 -0500 Subject: [PATCH] WIP on formatting --- src/MyWebLog.Data/Interfaces.fs | 3 +- src/MyWebLog.Data/PostgresData.fs | 6 +- src/MyWebLog.Data/RethinkDbData.fs | 39 ++++---- src/MyWebLog.Data/Utils.fs | 17 ++-- src/MyWebLog/Caches.fs | 46 ++++----- src/MyWebLog/DotLiquidBespoke.fs | 16 +-- src/MyWebLog/Handlers/Admin.fs | 74 +++++++------- src/MyWebLog/Handlers/Feed.fs | 43 ++++---- src/MyWebLog/Handlers/Helpers.fs | 93 +++++++++--------- src/MyWebLog/Handlers/Page.fs | 7 +- src/MyWebLog/Handlers/Post.fs | 27 +++-- src/MyWebLog/Handlers/Routes.fs | 4 +- src/MyWebLog/Handlers/Upload.fs | 40 ++++---- src/MyWebLog/Handlers/User.fs | 37 +++---- src/MyWebLog/Maintenance.fs | 152 +++++++++++++---------------- src/MyWebLog/Program.fs | 98 +++++++++---------- 16 files changed, 331 insertions(+), 371 deletions(-) diff --git a/src/MyWebLog.Data/Interfaces.fs b/src/MyWebLog.Data/Interfaces.fs index 0ec05d5..15d8069 100644 --- a/src/MyWebLog.Data/Interfaces.fs +++ b/src/MyWebLog.Data/Interfaces.fs @@ -7,6 +7,7 @@ open Newtonsoft.Json open NodaTime /// The result of a category deletion attempt +[] type CategoryDeleteResult = /// The category was deleted successfully | CategoryDeleted @@ -32,7 +33,7 @@ type ICategoryData = abstract member Delete : CategoryId -> WebLogId -> Task /// Find all categories for a web log, sorted alphabetically and grouped by hierarchy - abstract member FindAllForView : WebLogId -> Task + abstract member FindAllForView : WebLogId -> Task /// Find a category by its ID abstract member FindById : CategoryId -> WebLogId -> Task diff --git a/src/MyWebLog.Data/PostgresData.fs b/src/MyWebLog.Data/PostgresData.fs index 1c01195..4ea5b44 100644 --- a/src/MyWebLog.Data/PostgresData.fs +++ b/src/MyWebLog.Data/PostgresData.fs @@ -9,15 +9,15 @@ open Newtonsoft.Json open Npgsql.FSharp /// Data implementation for PostgreSQL -type PostgresData (log : ILogger, ser : JsonSerializer) = +type PostgresData(log: ILogger, ser: JsonSerializer) = /// Create any needed tables let ensureTables () = backgroundTask { // Set up the PostgreSQL document store 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 + member _.Serialize<'T>(it: 'T) : string = Utils.serialize ser it + member _.Deserialize<'T>(it: string) : 'T = Utils.deserialize ser it } let! tables = diff --git a/src/MyWebLog.Data/RethinkDbData.fs b/src/MyWebLog.Data/RethinkDbData.fs index 068b2b1..59bf934 100644 --- a/src/MyWebLog.Data/RethinkDbData.fs +++ b/src/MyWebLog.Data/RethinkDbData.fs @@ -69,20 +69,20 @@ module private RethinkHelpers = let r = RethinkDB.R /// Verify that the web log ID matches before returning an item - let verifyWebLog<'T> webLogId (prop : 'T -> WebLogId) (f : Net.IConnection -> Task<'T option>) = + let verifyWebLog<'T> webLogId (prop: 'T -> WebLogId) (f: Net.IConnection -> Task<'T option>) = fun conn -> backgroundTask { match! f conn with Some it when (prop it) = webLogId -> return Some it | _ -> return None } /// Get the first item from a list, or None if the list is empty - let tryFirst<'T> (f : Net.IConnection -> Task<'T list>) = + let tryFirst<'T> (f: Net.IConnection -> Task<'T list>) = fun conn -> backgroundTask { let! results = f conn return results |> List.tryHead } /// Cast a strongly-typed list to an object list - let objList<'T> (objects : 'T list) = objects |> List.map (fun it -> it :> obj) + let objList<'T> (objects: 'T list) = objects |> List.map (fun it -> it :> obj) open System @@ -92,15 +92,15 @@ open RethinkDb.Driver.FSharp open RethinkHelpers /// RethinkDB implementation of data functions for myWebLog -type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger) = +type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger) = /// Match theme asset IDs by their prefix (the theme ID) let matchAssetByThemeId themeId = let keyPrefix = $"^{themeId}/" - fun (row : Ast.ReqlExpr) -> row[nameof ThemeAsset.Empty.Id].Match keyPrefix :> obj + fun (row: Ast.ReqlExpr) -> row[nameof ThemeAsset.Empty.Id].Match keyPrefix :> obj /// Function to exclude template text from themes - let withoutTemplateText (row : Ast.ReqlExpr) : obj = + let withoutTemplateText (row: Ast.ReqlExpr) : obj = {| Templates = row[nameof Theme.Empty.Templates].Without [| nameof ThemeTemplate.Empty.Text |] |} /// Ensure field indexes exist, as well as special indexes for selected tables @@ -192,7 +192,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger Array.tryFind (fun c -> fst c = cat.Id) |> Option.map snd - |> Option.defaultValue 0 - }) + |> Option.defaultValue 0 }) |> Array.ofSeq } @@ -331,7 +330,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger verifyWebLog webLogId (fun c -> c.WebLogId) <| conn + |> verifyWebLog webLogId _.WebLogId <| conn member _.FindByWebLog webLogId = rethink { withTable Table.Category @@ -533,7 +532,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger verifyWebLog webLogId (fun p -> p.WebLogId) <| conn + |> verifyWebLog webLogId _.WebLogId <| conn member _.FindByPermalink permalink webLogId = rethink { @@ -604,7 +603,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger verifyWebLog webLogId (fun p -> p.WebLogId) <| conn + |> verifyWebLog webLogId _.WebLogId <| conn member _.FindCurrentPermalink permalinks webLogId = backgroundTask { let! result = @@ -617,7 +616,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger tryFirst) conn - return result |> Option.map (fun post -> post.Permalink) + return result |> Option.map _.Permalink } member _.FindFullByWebLog webLogId = rethink { @@ -756,7 +755,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger verifyWebLog webLogId (_.WebLogId) <| conn + |> verifyWebLog webLogId _.WebLogId <| conn member _.FindByUrlValue urlValue webLogId = rethink { @@ -908,7 +907,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger verifyWebLog webLogId (fun u -> u.WebLogId) <| conn + |> verifyWebLog webLogId _.WebLogId <| conn match upload with | Some up -> do! rethink { @@ -939,7 +938,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { withTable Table.Upload - between [| webLogId :> obj; r.Minval () |] [| webLogId :> obj; r.Maxval () |] + between [| webLogId :> obj; r.Minval() |] [| webLogId :> obj; r.Maxval() |] [ Index Index.WebLogAndPath ] resultCursor; withRetryCursorDefault; toList conn } @@ -971,7 +970,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { + let! thePostIds = rethink<{| Id: string |} list> { withTable Table.Post getAll [ webLogId ] (nameof Post.Empty.WebLogId) pluck [ nameof Post.Empty.Id ] @@ -1078,7 +1077,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger verifyWebLog webLogId (fun u -> u.WebLogId) <| conn + |> verifyWebLog webLogId _.WebLogId <| conn member this.Delete userId webLogId = backgroundTask { match! this.FindById userId webLogId with @@ -1205,7 +1204,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { + let! version = rethink<{| Id: string |} list> { withTable Table.DbVersion limit 1 result; withRetryOnce conn diff --git a/src/MyWebLog.Data/Utils.fs b/src/MyWebLog.Data/Utils.fs index 2af59a7..f26ff02 100644 --- a/src/MyWebLog.Data/Utils.fs +++ b/src/MyWebLog.Data/Utils.fs @@ -9,17 +9,16 @@ open MyWebLog.ViewModels let currentDbVersion = "v2.1" /// 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 { for cat in cats |> List.filter (fun c -> c.ParentId = parentId) do let fullSlug = (match slugBase with Some it -> $"{it}/" | None -> "") + cat.Slug - { Id = string cat.Id - Slug = fullSlug - Name = cat.Name - Description = cat.Description - ParentNames = Array.ofList parentNames - // Post counts are filled on a second pass - PostCount = 0 - } + { Id = string cat.Id + Slug = fullSlug + Name = cat.Name + Description = cat.Description + ParentNames = Array.ofList parentNames + // Post counts are filled on a second pass + PostCount = 0 } yield! orderByHierarchy cats (Some cat.Id) (Some fullSlug) ([ cat.Name ] |> List.append parentNames) } diff --git a/src/MyWebLog/Caches.fs b/src/MyWebLog/Caches.fs index 9230cae..c459920 100644 --- a/src/MyWebLog/Caches.fs +++ b/src/MyWebLog/Caches.fs @@ -13,25 +13,25 @@ module Extensions = open Microsoft.Extensions.DependencyInjection /// Hold variable for the configured generator string - let mutable private generatorString : string option = None + let mutable private generatorString: string option = None type HttpContext with /// The anti-CSRF service - member this.AntiForgery = this.RequestServices.GetRequiredService () + 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 () + member this.Data = this.RequestServices.GetRequiredService() /// The generator string member this.Generator = match generatorString with | Some gen -> gen | None -> - let cfg = this.RequestServices.GetRequiredService () + let cfg = this.RequestServices.GetRequiredService() generatorString <- match Option.ofObj cfg["Generator"] with | Some gen -> Some gen @@ -84,7 +84,7 @@ module WebLogCache = let tryGet (path : string) = _cache |> List.filter (fun wl -> path.StartsWith wl.UrlBase) - |> List.sortByDescending (fun wl -> wl.UrlBase.Length) + |> List.sortByDescending _.UrlBase.Length |> List.tryHead /// Cache the web log for a particular host @@ -106,8 +106,8 @@ module WebLogCache = _cache /// Fill the web log cache from the database - let fill (data : IData) = backgroundTask { - let! webLogs = data.WebLog.All () + let fill (data: IData) = backgroundTask { + let! webLogs = data.WebLog.All() webLogs |> List.iter set } @@ -126,28 +126,28 @@ module PageListCache = open MyWebLog.ViewModels /// Cache of displayed pages - let private _cache = ConcurrentDictionary () + let private _cache = ConcurrentDictionary () - let private fillPages (webLog : WebLog) pages = + 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 + 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] + let get (ctx: HttpContext) = _cache[ctx.WebLog.Id] /// 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 fillPages ctx.WebLog pages } /// 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 fillPages webLog pages } @@ -159,22 +159,22 @@ 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 + 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] + let get (ctx: HttpContext) = _cache[ctx.WebLog.Id] /// 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 _cache[ctx.WebLog.Id] <- cats } /// 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 _cache[webLogId] <- cats } @@ -191,7 +191,7 @@ module TemplateCache = let private _cache = ConcurrentDictionary () /// Custom include parameter pattern - let private hasInclude = Regex ("""{% include_template \"(.*)\" %}""", RegexOptions.None, TimeSpan.FromSeconds 2) + let private hasInclude = Regex("""{% include_template \"(.*)\" %}""", RegexOptions.None, TimeSpan.FromSeconds 2) /// Get a template for the given theme and template name let get (themeId: ThemeId) (templateName: string) (data: IData) = backgroundTask { @@ -220,7 +220,7 @@ module TemplateCache = let s = if childNotFound.IndexOf ";" >= 0 then "s" else "" return Error $"Could not find the child template{s} {childNotFound} required by {templateName}" else - _cache[templatePath] <- Template.Parse (text, SyntaxCompatibility.DotLiquid22) + _cache[templatePath] <- Template.Parse(text, SyntaxCompatibility.DotLiquid22) return Ok _cache[templatePath] | None -> return Error $"Theme ID {themeId} does not have a template named {templateName}" @@ -254,14 +254,14 @@ module ThemeAssetCache = let get themeId = _cache[themeId] /// 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 _cache[themeId] <- assets |> List.map (fun a -> match a.Id with ThemeAssetId (_, path) -> path) } /// Fill the theme asset cache - let fill (data : IData) = backgroundTask { - let! assets = data.ThemeAsset.All () + let fill (data: IData) = backgroundTask { + let! assets = data.ThemeAsset.All() for asset in assets do let (ThemeAssetId (themeId, path)) = asset.Id if not (_cache.ContainsKey themeId) then _cache[themeId] <- [] diff --git a/src/MyWebLog/DotLiquidBespoke.fs b/src/MyWebLog/DotLiquidBespoke.fs index 8cfdc9d..73594f1 100644 --- a/src/MyWebLog/DotLiquidBespoke.fs +++ b/src/MyWebLog/DotLiquidBespoke.fs @@ -17,7 +17,7 @@ type Context with /// Does an asset exist for the current theme? -let assetExists fileName (webLog : WebLog) = +let assetExists fileName (webLog: WebLog) = ThemeAssetCache.get webLog.ThemeId |> List.exists (fun it -> it = fileName) /// Obtain the link from known types @@ -149,10 +149,10 @@ type PageHeadTag() = /// Create various items in the page header based on the state of the page being generated -type PageFootTag () = - inherit Tag () +type PageFootTag() = + inherit Tag() - override this.Render (context : Context, result : TextWriter) = + override this.Render(context: Context, result: TextWriter) = let webLog = context.WebLog // spacer let s = " " @@ -161,12 +161,12 @@ type PageFootTag () = result.WriteLine $"{s}{RenderView.AsString.htmlNode Htmx.Script.minified}" if assetExists "script.js" webLog then - result.WriteLine $"""{s}""" + result.WriteLine $"""{s}""" + - /// A filter to generate a relative link -type RelativeLinkFilter () = - static member RelativeLink (ctx : Context, item : obj) = +type RelativeLinkFilter() = + static member RelativeLink(ctx: Context, item: obj) = permalink item ctx.WebLog.RelativeUrl diff --git a/src/MyWebLog/Handlers/Admin.fs b/src/MyWebLog/Handlers/Admin.fs index bae83c0..136d793 100644 --- a/src/MyWebLog/Handlers/Admin.fs +++ b/src/MyWebLog/Handlers/Admin.fs @@ -12,7 +12,7 @@ module Dashboard = // GET /admin/dashboard let user : HttpHandler = requireAccess Author >=> fun next ctx -> task { - let getCount (f : WebLogId -> Task) = f ctx.WebLog.Id + let getCount (f: WebLogId -> Task) = f ctx.WebLog.Id let data = ctx.Data let! posts = getCount (data.Post.CountByStatus Published) let! drafts = getCount (data.Post.CountByStatus Draft) @@ -89,7 +89,7 @@ module Cache = do! addMessage ctx { UserMessage.Success with Message = "Successfully refresh web log cache for all web logs" } else - match! data.WebLog.FindById (WebLogId webLogId) with + match! data.WebLog.FindById(WebLogId webLogId) with | Some webLog -> WebLogCache.set webLog do! PageListCache.refresh webLog data @@ -109,17 +109,15 @@ module Cache = do! ThemeAssetCache.fill data do! addMessage ctx { UserMessage.Success with - Message = "Successfully cleared template cache and refreshed theme asset cache" - } + Message = "Successfully cleared template cache and refreshed theme asset cache" } else - match! data.Theme.FindById (ThemeId themeId) with + match! data.Theme.FindById(ThemeId themeId) with | Some theme -> TemplateCache.invalidateTheme theme.Id do! ThemeAssetCache.refreshTheme theme.Id data do! addMessage ctx { UserMessage.Success with - Message = $"Successfully cleared template cache and refreshed theme asset cache for {theme.Name}" - } + Message = $"Successfully cleared template cache and refreshed theme asset cache for {theme.Name}" } | None -> do! addMessage ctx { UserMessage.Error with Message = $"No theme exists with ID {themeId}" } return! toAdminDashboard next ctx @@ -156,10 +154,10 @@ module Category = let edit catId : HttpHandler = fun next ctx -> task { let! result = task { match catId with - | "new" -> return Some ("Add a New Category", { Category.Empty with Id = CategoryId "new" }) + | "new" -> return Some("Add a New Category", { Category.Empty with Id = CategoryId "new" }) | _ -> match! ctx.Data.Category.FindById (CategoryId catId) ctx.WebLog.Id with - | Some cat -> return Some ("Edit Category", cat) + | Some cat -> return Some("Edit Category", cat) | None -> return None } match result with @@ -175,7 +173,7 @@ module Category = // POST /admin/category/save let save : HttpHandler = fun next ctx -> task { let data = ctx.Data - let! model = ctx.BindFormAsync () + let! model = ctx.BindFormAsync() let category = if model.IsNew then someTask { Category.Empty with Id = CategoryId.Create(); WebLogId = ctx.WebLog.Id } else data.Category.FindById (CategoryId model.CategoryId) ctx.WebLog.Id @@ -186,8 +184,7 @@ module Category = Name = model.Name Slug = model.Slug Description = if model.Description = "" then None else Some model.Description - ParentId = if model.ParentId = "" then None else Some (CategoryId model.ParentId) - } + ParentId = if model.ParentId = "" then None else Some(CategoryId model.ParentId) } do! (if model.IsNew then data.Category.Add else data.Category.Update) updatedCat do! CategoryCache.update ctx do! addMessage ctx { UserMessage.Success with Message = "Category saved successfully" } @@ -249,7 +246,7 @@ module RedirectRules = } /// Update the web log's redirect rules in the database, the request web log, and the web log cache - let private updateRedirectRules (ctx : HttpContext) webLog = backgroundTask { + let private updateRedirectRules (ctx: HttpContext) webLog = backgroundTask { do! ctx.Data.WebLog.UpdateRedirectRules webLog ctx.Items["webLog"] <- webLog WebLogCache.set webLog @@ -311,7 +308,7 @@ module TagMapping = open Microsoft.AspNetCore.Http /// Add tag mappings to the given hash - let withTagMappings (ctx : HttpContext) hash = task { + let withTagMappings (ctx: HttpContext) hash = task { let! mappings = ctx.Data.TagMap.FindByWebLog ctx.WebLog.Id return addToHash "mappings" mappings hash @@ -414,9 +411,9 @@ module Theme = zip.Entries |> Seq.filter (fun it -> it.Name.EndsWith ".liquid") |> Seq.map (fun templateItem -> backgroundTask { - use templateFile = new StreamReader (templateItem.Open ()) - let! template = templateFile.ReadToEndAsync () - return { Name = templateItem.Name.Replace (".liquid", ""); Text = template } + use templateFile = new StreamReader(templateItem.Open()) + let! template = templateFile.ReadToEndAsync() + return { Name = templateItem.Name.Replace(".liquid", ""); Text = template } }) let! templates = Task.WhenAll tasks return @@ -427,37 +424,37 @@ module Theme = } /// Update theme assets from the ZIP archive - let private updateAssets themeId (zip : ZipArchive) (data : IData) = backgroundTask { - for asset in zip.Entries |> Seq.filter (fun it -> it.FullName.StartsWith "wwwroot") do - let assetName = asset.FullName.Replace ("wwwroot/", "") + let private updateAssets themeId (zip: ZipArchive) (data: IData) = backgroundTask { + for asset in zip.Entries |> Seq.filter _.FullName.StartsWith("wwwroot") do + let assetName = asset.FullName.Replace("wwwroot/", "") if assetName <> "" && not (assetName.EndsWith "/") then - use stream = new MemoryStream () + use stream = new MemoryStream() do! asset.Open().CopyToAsync stream do! data.ThemeAsset.Save - { Id = ThemeAssetId (themeId, assetName) + { Id = ThemeAssetId(themeId, assetName) UpdatedOn = LocalDateTime.FromDateTime(asset.LastWriteTime.DateTime) - .InZoneLeniently(DateTimeZone.Utc).ToInstant () - Data = stream.ToArray () + .InZoneLeniently(DateTimeZone.Utc).ToInstant() + Data = stream.ToArray() } } /// Derive the theme ID from the file name given - let deriveIdFromFileName (fileName : string) = - let themeName = fileName.Split(".").[0].ToLowerInvariant().Replace (" ", "-") + let deriveIdFromFileName (fileName: string) = + let themeName = fileName.Split(".").[0].ToLowerInvariant().Replace(" ", "-") if themeName.EndsWith "-theme" then - if Regex.IsMatch (themeName, """^[a-z0-9\-]+$""") then - Ok (ThemeId (themeName.Substring (0, themeName.Length - 6))) + if Regex.IsMatch(themeName, """^[a-z0-9\-]+$""") then + Ok(ThemeId(themeName[..themeName.Length - 6])) else Error $"Theme ID {fileName} is invalid" else Error "Theme .zip file name must end in \"-theme.zip\"" /// Load a theme from the given stream, which should contain a ZIP archive - let loadFromZip themeId file (data : IData) = backgroundTask { + let loadFromZip themeId file (data: IData) = backgroundTask { let! isNew, theme = backgroundTask { match! data.Theme.FindById themeId with | Some t -> return false, t | None -> return true, { Theme.Empty with Id = themeId } } - use zip = new ZipArchive (file, ZipArchiveMode.Read) + use zip = new ZipArchive(file, ZipArchiveMode.Read) let! theme = updateNameAndVersion theme zip if not isNew then do! data.ThemeAsset.DeleteByTheme theme.Id let! theme = updateTemplates { theme with Templates = [] } zip @@ -489,14 +486,12 @@ module Theme = do! themeFile.CopyToAsync file do! addMessage ctx { UserMessage.Success with - Message = $"""Theme {if isNew then "add" else "updat"}ed successfully""" - } + Message = $"""Theme {if isNew then "add" else "updat"}ed successfully""" } return! toAdminDashboard next ctx else do! addMessage ctx { UserMessage.Error with - Message = "Theme exists and overwriting was not requested; nothing saved" - } + Message = "Theme exists and overwriting was not requested; nothing saved" } return! toAdminDashboard next ctx | Ok _ -> do! addMessage ctx { UserMessage.Error with Message = "You may not replace the admin theme" } @@ -517,8 +512,7 @@ module Theme = | it when WebLogCache.isThemeInUse (ThemeId it) -> do! addMessage ctx { UserMessage.Error with - Message = $"You may not delete the {themeId} theme, as it is currently in use" - } + Message = $"You may not delete the {themeId} theme, as it is currently in use" } return! all next ctx | _ -> match! data.Theme.Delete (ThemeId themeId) with @@ -588,7 +582,7 @@ module WebLog = // POST /admin/settings let saveSettings : HttpHandler = fun next ctx -> task { let data = ctx.Data - let! model = ctx.BindFormAsync () + let! model = ctx.BindFormAsync() match! data.WebLog.FindById ctx.WebLog.Id with | Some webLog -> let oldSlug = webLog.Slug @@ -600,9 +594,9 @@ module WebLog = if oldSlug <> webLog.Slug then // Rename disk directory if it exists - let uploadRoot = Path.Combine ("wwwroot", "upload") - let oldDir = Path.Combine (uploadRoot, oldSlug) - if Directory.Exists oldDir then Directory.Move (oldDir, Path.Combine (uploadRoot, webLog.Slug)) + let uploadRoot = Path.Combine("wwwroot", "upload") + let oldDir = Path.Combine(uploadRoot, oldSlug) + if Directory.Exists oldDir then Directory.Move(oldDir, Path.Combine(uploadRoot, webLog.Slug)) do! addMessage ctx { UserMessage.Success with Message = "Web log settings saved successfully" } return! redirectToGet "admin/settings" next ctx diff --git a/src/MyWebLog/Handlers/Feed.fs b/src/MyWebLog/Handlers/Feed.fs index 35b668b..94dfd75 100644 --- a/src/MyWebLog/Handlers/Feed.fs +++ b/src/MyWebLog/Handlers/Feed.fs @@ -23,7 +23,7 @@ type FeedType = | Custom of CustomFeed * string /// Derive the type of RSS feed requested -let deriveFeedType (ctx : HttpContext) feedPath : (FeedType * int) option = +let deriveFeedType (ctx: HttpContext) feedPath : (FeedType * int) option = let webLog = ctx.WebLog let debug = debug "Feed" ctx let name = $"/{webLog.Rss.FeedName}" @@ -33,14 +33,14 @@ let deriveFeedType (ctx : HttpContext) feedPath : (FeedType * int) option = match webLog.Rss.IsFeedEnabled && feedPath = name with | true -> debug (fun () -> "Found standard feed") - Some (StandardFeed feedPath, postCount) + Some(StandardFeed feedPath, postCount) | false -> // Category and tag feeds are handled by defined routes; check for custom feed match webLog.Rss.CustomFeeds |> List.tryFind (fun it -> feedPath.EndsWith(string it.Path)) with | Some feed -> debug (fun () -> "Found custom feed") - Some (Custom (feed, feedPath), feed.Podcast |> Option.map _.ItemsInFeed |> Option.defaultValue postCount) + Some(Custom(feed, feedPath), feed.Podcast |> Option.map _.ItemsInFeed |> Option.defaultValue postCount) | None -> debug (fun () -> "No matching feed found") None @@ -61,7 +61,7 @@ let private getFeedPosts ctx feedType = | Tag tag -> data.Post.FindPageOfTaggedPosts ctx.WebLog.Id tag 1 /// Strip HTML from a string -let private stripHtml text = WebUtility.HtmlDecode <| Regex.Replace (text, "<(.|\n)*?>", "") +let private stripHtml text = WebUtility.HtmlDecode <| Regex.Replace(text, "<(.|\n)*?>", "") /// XML namespaces for building RSS feeds [] @@ -231,8 +231,8 @@ let private addEpisode (webLog: WebLog) (podcast: PodcastOptions) (episode: Epis item /// Add a namespace to the feed -let private addNamespace (feed : SyndicationFeed) alias nsUrl = - feed.AttributeExtensions.Add (XmlQualifiedName (alias, "http://www.w3.org/2000/xmlns/"), nsUrl) +let private addNamespace (feed: SyndicationFeed) alias nsUrl = + feed.AttributeExtensions.Add(XmlQualifiedName(alias, "http://www.w3.org/2000/xmlns/"), nsUrl) /// Add items to the top of the feed required for podcasts let private addPodcast (webLog: WebLog) (rssFeed: SyndicationFeed) (feed: CustomFeed) = @@ -313,7 +313,7 @@ let private addPodcast (webLog: WebLog) (rssFeed: SyndicationFeed) (feed: Custom /// Get the feed's self reference and non-feed link let private selfAndLink webLog feedType ctx = - let withoutFeed (it : string) = Permalink (it.Replace ($"/{webLog.Rss.FeedName}", "")) + let withoutFeed (it: string) = Permalink(it.Replace($"/{webLog.Rss.FeedName}", "")) match feedType with | StandardFeed path | CategoryFeed (_, path) @@ -325,8 +325,8 @@ let private selfAndLink webLog feedType ctx = | Tag tag -> feed.Path, Permalink $"""tag/{tag.Replace(" ", "+")}/""" /// Set the title and description of the feed based on its source -let private setTitleAndDescription feedType (webLog : WebLog) (cats : DisplayCategory[]) (feed : SyndicationFeed) = - let cleanText opt def = TextSyndicationContent (stripHtml (defaultArg opt def)) +let private setTitleAndDescription feedType (webLog: WebLog) (cats: DisplayCategory[]) (feed: SyndicationFeed) = + let cleanText opt def = TextSyndicationContent(stripHtml (defaultArg opt def)) match feedType with | StandardFeed _ -> feed.Title <- cleanText None webLog.Name @@ -412,7 +412,7 @@ let generate (feedType: FeedType) postCount : HttpHandler = fun next ctx -> back // POST /admin/settings/rss let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { let data = ctx.Data - let! model = ctx.BindFormAsync () + let! model = ctx.BindFormAsync() match! data.WebLog.FindById ctx.WebLog.Id with | Some webLog -> let webLog = { webLog with Rss = model.UpdateOptions webLog.Rss } @@ -452,7 +452,7 @@ let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> let data = ctx.Data match! data.WebLog.FindById ctx.WebLog.Id with | Some webLog -> - let! model = ctx.BindFormAsync () + let! model = ctx.BindFormAsync() let theFeed = match model.Id with | "new" -> Some { CustomFeed.Empty with Id = CustomFeedId.Create() } @@ -460,13 +460,12 @@ let saveCustomFeed : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> match theFeed with | Some feed -> let feeds = model.UpdateFeed feed :: (webLog.Rss.CustomFeeds |> List.filter (fun it -> it.Id <> feed.Id)) - let webLog = { webLog with Rss = { webLog.Rss with CustomFeeds = feeds } } + let webLog = { webLog with Rss.CustomFeeds = feeds } do! data.WebLog.UpdateRssOptions webLog WebLogCache.set webLog - do! addMessage ctx { - UserMessage.Success with - Message = $"""Successfully {if model.Id = "new" then "add" else "sav"}ed custom feed""" - } + do! addMessage ctx + { UserMessage.Success with + Message = $"""Successfully {if model.Id = "new" then "add" else "sav"}ed custom feed""" } return! redirectToGet $"admin/settings/rss/{feed.Id}/edit" next ctx | None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx @@ -479,13 +478,11 @@ let deleteCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun ne | Some webLog -> let customId = CustomFeedId feedId if webLog.Rss.CustomFeeds |> List.exists (fun f -> f.Id = customId) then - let webLog = { - webLog with - Rss = { - webLog.Rss with - CustomFeeds = webLog.Rss.CustomFeeds |> List.filter (fun f -> f.Id <> customId) - } - } + let webLog = + { webLog with + Rss = + { webLog.Rss with + CustomFeeds = webLog.Rss.CustomFeeds |> List.filter (fun f -> f.Id <> customId) } } do! data.WebLog.UpdateRssOptions webLog WebLogCache.set webLog do! addMessage ctx { UserMessage.Success with Message = "Custom feed deleted successfully" } diff --git a/src/MyWebLog/Handlers/Helpers.fs b/src/MyWebLog/Handlers/Helpers.fs index 07041af..49a1f5f 100644 --- a/src/MyWebLog/Handlers/Helpers.fs +++ b/src/MyWebLog/Handlers/Helpers.fs @@ -8,8 +8,8 @@ open Microsoft.AspNetCore.Http type ISession with /// Set an item in the session - member this.Set<'T> (key, item : 'T) = - this.SetString (key, JsonSerializer.Serialize item) + member this.Set<'T>(key, item: 'T) = + this.SetString(key, JsonSerializer.Serialize item) /// Get an item from the session member this.TryGet<'T> key = @@ -126,28 +126,28 @@ module ViewContext = let private sessionLoadedKey = "session-loaded" /// Load the session if it has not been loaded already; ensures async access but not excessive loading -let private loadSession (ctx : HttpContext) = task { +let private loadSession (ctx: HttpContext) = task { if not (ctx.Items.ContainsKey sessionLoadedKey) then - do! ctx.Session.LoadAsync () - ctx.Items.Add (sessionLoadedKey, "yes") + do! ctx.Session.LoadAsync() + ctx.Items.Add(sessionLoadedKey, "yes") } /// Ensure that the session is committed -let private commitSession (ctx : HttpContext) = task { - if ctx.Items.ContainsKey sessionLoadedKey then do! ctx.Session.CommitAsync () +let private commitSession (ctx: HttpContext) = task { + if ctx.Items.ContainsKey sessionLoadedKey then do! ctx.Session.CommitAsync() } open MyWebLog.ViewModels /// Add a message to the user's session -let addMessage (ctx : HttpContext) message = task { +let addMessage (ctx: HttpContext) message = task { do! loadSession ctx let msg = match ctx.Session.TryGet ViewContext.Messages with Some it -> it | None -> [] - ctx.Session.Set (ViewContext.Messages, message :: msg) + ctx.Session.Set(ViewContext.Messages, message :: msg) } /// Get any messages from the user's session, removing them in the process -let messages (ctx : HttpContext) = task { +let messages (ctx: HttpContext) = task { do! loadSession ctx match ctx.Session.TryGet ViewContext.Messages with | Some msg -> @@ -160,21 +160,21 @@ open MyWebLog open DotLiquid /// Shorthand for creating a DotLiquid hash from an anonymous object -let makeHash (values : obj) = +let makeHash (values: obj) = Hash.FromAnonymousObject values /// Create a hash with the page title filled -let hashForPage (title : string) = +let hashForPage (title: string) = makeHash {| page_title = title |} /// Add a key to the hash, returning the modified hash // (note that the hash itself is mutated; this is only used to make it pipeable) -let addToHash key (value : obj) (hash : Hash) = - if hash.ContainsKey key then hash[key] <- value else hash.Add (key, value) +let addToHash key (value: obj) (hash: Hash) = + if hash.ContainsKey key then hash[key] <- value else hash.Add(key, value) hash /// Add anti-CSRF tokens to the given hash -let withAntiCsrf (ctx : HttpContext) = +let withAntiCsrf (ctx: HttpContext) = addToHash ViewContext.AntiCsrfTokens ctx.CsrfTokenSet open System.Security.Claims @@ -186,13 +186,13 @@ open Giraffe.ViewEngine let private htmxScript = RenderView.AsString.htmlNode Htmx.Script.minified /// Populate the DotLiquid hash with standard information -let addViewContext ctx (hash : Hash) = task { +let addViewContext ctx (hash: Hash) = task { let! messages = messages ctx do! commitSession ctx return if hash.ContainsKey ViewContext.HtmxScript && hash.ContainsKey ViewContext.Messages then // We have already populated everything; just update messages - hash[ViewContext.Messages] <- Array.concat [ hash[ViewContext.Messages] :?> UserMessage[]; messages ] + hash[ViewContext.Messages] <- Array.concat [ hash[ViewContext.Messages] :?> UserMessage array; messages ] hash else ctx.User.Claims @@ -214,11 +214,11 @@ let addViewContext ctx (hash : Hash) = task { } /// Is the request from htmx? -let isHtmx (ctx : HttpContext) = +let isHtmx (ctx: HttpContext) = ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh /// Convert messages to headers (used for htmx responses) -let messagesToHeaders (messages : UserMessage array) : HttpHandler = +let messagesToHeaders (messages: UserMessage array) : HttpHandler = seq { yield! messages @@ -253,8 +253,7 @@ module Error = if isHtmx ctx then let messages = [| { UserMessage.Error with - Message = $"You are not authorized to access the URL {ctx.Request.Path.Value}" - } + Message = $"You are not authorized to access the URL {ctx.Request.Path.Value}" } |] (messagesToHeaders messages >=> setStatusCode 401) earlyReturn ctx else setStatusCode 401 earlyReturn ctx @@ -278,7 +277,7 @@ module Error = /// Render a view for the specified theme, using the specified template, layout, and hash -let viewForTheme themeId template next ctx (hash : Hash) = task { +let viewForTheme themeId template next ctx (hash: Hash) = task { let! hash = addViewContext ctx hash // NOTE: DotLiquid does not support {% render %} or {% include %} in its templates, so we will do a 2-pass render; @@ -296,13 +295,13 @@ let viewForTheme themeId template next ctx (hash : Hash) = task { } /// Render a bare view for the specified theme, using the specified template and hash -let bareForTheme themeId template next ctx (hash : Hash) = task { +let bareForTheme themeId template next ctx (hash: Hash) = task { let! hash = addViewContext ctx hash let withContent = task { if hash.ContainsKey ViewContext.Content then return Ok hash else match! TemplateCache.get themeId template ctx.Data with - | Ok contentTemplate -> return Ok (addToHash ViewContext.Content (contentTemplate.Render hash) hash) + | Ok contentTemplate -> return Ok(addToHash ViewContext.Content (contentTemplate.Render hash) hash) | Error message -> return Error message } match! withContent with @@ -311,7 +310,7 @@ let bareForTheme themeId template next ctx (hash : Hash) = task { match! TemplateCache.get themeId "layout-bare" ctx.Data with | Ok layoutTemplate -> return! - (messagesToHeaders (hash[ViewContext.Messages] :?> UserMessage[]) + (messagesToHeaders (hash[ViewContext.Messages] :?> UserMessage array) >=> htmlString (layoutTemplate.Render completeHash)) next ctx | Error message -> return! Error.server message next ctx @@ -353,8 +352,7 @@ let requireAccess level : HttpHandler = fun next ctx -> task { do! addMessage ctx { UserMessage.Warning with Message = $"The page you tried to access requires {level} privileges" - Detail = Some $"Your account only has {userLevel} privileges" - } + Detail = Some $"Your account only has {userLevel} privileges" } return! Error.notAuthorized next ctx | None -> do! addMessage ctx @@ -363,44 +361,44 @@ let requireAccess level : HttpHandler = fun next ctx -> task { } /// Determine if a user is authorized to edit a page or post, given the author -let canEdit authorId (ctx : HttpContext) = +let canEdit authorId (ctx: HttpContext) = ctx.UserId = authorId || ctx.HasAccessLevel Editor open System.Threading.Tasks /// Create a Task with a Some result for the given object -let someTask<'T> (it : 'T) = Task.FromResult (Some it) +let someTask<'T> (it: 'T) = Task.FromResult(Some it) open System.Collections.Generic open MyWebLog.Data /// Get the templates available for the current web log's theme (in a key/value pair list) -let templatesForTheme (ctx : HttpContext) (typ : string) = backgroundTask { +let templatesForTheme (ctx: HttpContext) (typ: string) = backgroundTask { match! ctx.Data.Theme.FindByIdWithoutText ctx.WebLog.ThemeId with | Some theme -> return seq { - KeyValuePair.Create ("", $"- Default (single-{typ}) -") + KeyValuePair.Create("", $"- Default (single-{typ}) -") yield! theme.Templates |> Seq.ofList |> Seq.filter (fun it -> it.Name.EndsWith $"-{typ}" && it.Name <> $"single-{typ}") - |> Seq.map (fun it -> KeyValuePair.Create (it.Name, it.Name)) + |> Seq.map (fun it -> KeyValuePair.Create(it.Name, it.Name)) } |> Array.ofSeq - | None -> return [| KeyValuePair.Create ("", $"- Default (single-{typ}) -") |] + | None -> return [| KeyValuePair.Create("", $"- Default (single-{typ}) -") |] } /// Get all authors for a list of posts as metadata items -let getAuthors (webLog : WebLog) (posts : Post list) (data : IData) = +let getAuthors (webLog: WebLog) (posts: Post list) (data: IData) = posts - |> List.map (fun p -> p.AuthorId) + |> List.map _.AuthorId |> List.distinct |> data.WebLogUser.FindNames webLog.Id /// Get all tag mappings for a list of posts as metadata items -let getTagMappings (webLog : WebLog) (posts : Post list) (data : IData) = +let getTagMappings (webLog: WebLog) (posts: Post list) (data: IData) = posts - |> List.map (fun p -> p.Tags) + |> List.map _.Tags |> List.concat |> List.distinct |> fun tags -> data.TagMap.FindMappingForTags tags webLog.Id @@ -421,8 +419,8 @@ open System.Globalization open NodaTime /// Parse a date/time to UTC -let parseToUtc (date : string) = - Instant.FromDateTimeUtc (DateTime.Parse (date, null, DateTimeStyles.AdjustToUniversal)) +let parseToUtc (date: string) = + Instant.FromDateTimeUtc(DateTime.Parse(date, null, DateTimeStyles.AdjustToUniversal)) open Microsoft.Extensions.DependencyInjection open Microsoft.Extensions.Logging @@ -431,25 +429,24 @@ open Microsoft.Extensions.Logging let mutable private debugEnabled : bool option = None /// Is debug enabled for handlers? -let private isDebugEnabled (ctx : HttpContext) = +let private isDebugEnabled (ctx: HttpContext) = match debugEnabled with | Some flag -> flag | None -> - let fac = ctx.RequestServices.GetRequiredService () + let fac = ctx.RequestServices.GetRequiredService() let log = fac.CreateLogger "MyWebLog.Handlers" - debugEnabled <- Some (log.IsEnabled LogLevel.Debug) + debugEnabled <- Some(log.IsEnabled LogLevel.Debug) debugEnabled.Value /// Log a debug message -let debug (name : string) ctx msg = +let debug (name: string) ctx msg = if isDebugEnabled ctx then - let fac = ctx.RequestServices.GetRequiredService () + let fac = ctx.RequestServices.GetRequiredService() let log = fac.CreateLogger $"MyWebLog.Handlers.{name}" - log.LogDebug (msg ()) + log.LogDebug(msg ()) /// Log a warning message -let warn (name : string) (ctx : HttpContext) msg = - let fac = ctx.RequestServices.GetRequiredService () +let warn (name: string) (ctx: HttpContext) msg = + let fac = ctx.RequestServices.GetRequiredService() let log = fac.CreateLogger $"MyWebLog.Handlers.{name}" log.LogWarning msg - \ No newline at end of file diff --git a/src/MyWebLog/Handlers/Page.fs b/src/MyWebLog/Handlers/Page.fs index 9609427..28b8074 100644 --- a/src/MyWebLog/Handlers/Page.fs +++ b/src/MyWebLog/Handlers/Page.fs @@ -76,7 +76,7 @@ let editPermalinks pgId : HttpHandler = requireAccess Author >=> fun next ctx -> // POST /admin/page/permalinks let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task { - let! model = ctx.BindFormAsync () + let! model = ctx.BindFormAsync() let pageId = PageId model.Id match! ctx.Data.Page.FindById pageId ctx.WebLog.Id with | Some pg when canEdit pg.AuthorId ctx -> @@ -117,7 +117,7 @@ let purgeRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx -> open Microsoft.AspNetCore.Http /// Find the page and the requested revision -let private findPageRevision pgId revDate (ctx : HttpContext) = task { +let private findPageRevision pgId revDate (ctx: HttpContext) = task { match! ctx.Data.Page.FindFullById (PageId pgId) ctx.WebLog.Id with | Some pg -> let asOf = parseToUtc revDate @@ -150,8 +150,7 @@ let restoreRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun do! ctx.Data.Page.Update { pg with Revisions = { rev with AsOf = Noda.now () } - :: (pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf)) - } + :: (pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf)) } do! addMessage ctx { UserMessage.Success with Message = "Revision restored successfully" } return! redirectToGet $"admin/page/{pgId}/revisions" next ctx | Some _, Some _ -> return! Error.notAuthorized next ctx diff --git a/src/MyWebLog/Handlers/Post.fs b/src/MyWebLog/Handlers/Post.fs index 780cac5..c5d6bec 100644 --- a/src/MyWebLog/Handlers/Post.fs +++ b/src/MyWebLog/Handlers/Post.fs @@ -6,7 +6,7 @@ open System.Collections.Generic open MyWebLog /// Parse a slug and page number from an "everything else" URL -let private parseSlugAndPage webLog (slugAndPage : string seq) = +let private parseSlugAndPage webLog (slugAndPage: string seq) = let fullPath = slugAndPage |> Seq.head let slugPath = slugAndPage |> Seq.skip 1 |> Seq.head let slugs, isFeed = @@ -24,9 +24,10 @@ let private parseSlugAndPage webLog (slugAndPage : string seq) = | idx when idx + 2 = slugs.Length -> Some (int slugs[pageIdx + 1]) | _ -> None let slugParts = if pageIdx > 0 then Array.truncate pageIdx slugs else slugs - pageNbr, String.Join ("/", slugParts), isFeed + pageNbr, String.Join("/", slugParts), isFeed /// The type of post list being prepared +[] type ListType = | AdminList | CategoryList @@ -55,7 +56,7 @@ let preparePostList webLog posts listType (url: string) pageNbr perPage (data: I let post = List.head posts let target = defaultArg post.PublishedOn post.UpdatedOn data.Post.FindSurroundingPosts webLog.Id target - | _ -> Task.FromResult (None, None) + | _ -> Task.FromResult(None, None) let newerLink = match listType, pageNbr with | SinglePost, _ -> newerPost |> Option.map (fun it -> string it.Permalink) @@ -114,7 +115,7 @@ let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task { } // GET /page/{pageNbr}/ -let redirectToPageOfPosts (pageNbr : int) : HttpHandler = fun next ctx -> +let redirectToPageOfPosts (pageNbr: int) : HttpHandler = fun next ctx -> redirectTo true (ctx.WebLog.RelativeUrl(Permalink $"page/{pageNbr}")) next ctx // GET /category/{slug}/ @@ -163,7 +164,7 @@ let pageOfTaggedPosts slugAndPage : HttpHandler = fun next ctx -> task { | None -> return urlTag } if isFeed then - return! Feed.generate (Feed.TagFeed (tag, $"tag/{rawTag}/{webLog.Rss.FeedName}")) + return! Feed.generate (Feed.TagFeed(tag, $"tag/{rawTag}/{webLog.Rss.FeedName}")) (defaultArg webLog.Rss.ItemsInFeed webLog.PostsPerPage) next ctx else match! data.Post.FindPageOfTaggedPosts webLog.Id tag pageNbr webLog.PostsPerPage with @@ -178,7 +179,7 @@ let pageOfTaggedPosts slugAndPage : HttpHandler = fun next ctx -> task { |> themedView "index" next ctx // Other systems use hyphens for spaces; redirect if this is an old tag link | _ -> - let spacedTag = tag.Replace ("-", " ") + let spacedTag = tag.Replace("-", " ") match! data.Post.FindPageOfTaggedPosts webLog.Id spacedTag pageNbr 1 with | posts when List.length posts > 0 -> let endUrl = if pageNbr = 1 then "" else $"page/{pageNbr}" @@ -275,7 +276,7 @@ let editPermalinks postId : HttpHandler = requireAccess Author >=> fun next ctx // POST /admin/post/permalinks let savePermalinks : HttpHandler = requireAccess Author >=> fun next ctx -> task { - let! model = ctx.BindFormAsync () + let! model = ctx.BindFormAsync() let postId = PostId model.Id match! ctx.Data.Post.FindById postId ctx.WebLog.Id with | Some post when canEdit post.AuthorId ctx -> @@ -317,7 +318,7 @@ let purgeRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx open Microsoft.AspNetCore.Http /// Find the post and the requested revision -let private findPostRevision postId revDate (ctx : HttpContext) = task { +let private findPostRevision postId revDate (ctx: HttpContext) = task { match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with | Some post -> let asOf = parseToUtc revDate @@ -350,8 +351,7 @@ let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> f do! ctx.Data.Post.Update { post with Revisions = { rev with AsOf = Noda.now () } - :: (post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf)) - } + :: (post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf)) } do! addMessage ctx { UserMessage.Success with Message = "Revision restored successfully" } return! redirectToGet $"admin/post/{postId}/revisions" next ctx | Some _, Some _ -> return! Error.notAuthorized next ctx @@ -380,8 +380,8 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { { Post.Empty with Id = PostId.Create() WebLogId = ctx.WebLog.Id - AuthorId = ctx.UserId - } |> someTask + AuthorId = ctx.UserId } + |> someTask else data.Post.FindFullById (PostId model.PostId) ctx.WebLog.Id match! tryPost with | Some post when canEdit post.AuthorId ctx -> @@ -396,8 +396,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { { post with PublishedOn = Some dt UpdatedOn = dt - Revisions = [ { (List.head post.Revisions) with AsOf = dt } ] - } + Revisions = [ { (List.head post.Revisions) with AsOf = dt } ] } else { post with PublishedOn = Some dt } else post do! (if model.PostId = "new" then data.Post.Add else data.Post.Update) updatedPost diff --git a/src/MyWebLog/Handlers/Routes.fs b/src/MyWebLog/Handlers/Routes.fs index 52fe990..d103a00 100644 --- a/src/MyWebLog/Handlers/Routes.fs +++ b/src/MyWebLog/Handlers/Routes.fs @@ -11,7 +11,7 @@ module CatchAll = open MyWebLog.ViewModels /// Sequence where the first returned value is the proper handler for the link - let private deriveAction (ctx: HttpContext): HttpHandler seq = + let private deriveAction (ctx: HttpContext) : HttpHandler seq = let webLog = ctx.WebLog let data = ctx.Data let debug = debug "Routes.CatchAll" ctx @@ -80,7 +80,7 @@ module CatchAll = } // GET {all-of-the-above} - let route: HttpHandler = fun next ctx -> + let route : HttpHandler = fun next ctx -> match deriveAction ctx |> Seq.tryHead with Some handler -> handler next ctx | None -> Error.notFound next ctx diff --git a/src/MyWebLog/Handlers/Upload.fs b/src/MyWebLog/Handlers/Upload.fs index 3493bf6..aac82d9 100644 --- a/src/MyWebLog/Handlers/Upload.fs +++ b/src/MyWebLog/Handlers/Upload.fs @@ -12,7 +12,7 @@ module private Helpers = open Microsoft.AspNetCore.StaticFiles /// A MIME type mapper instance to use when serving files from the database - let mimeMap = FileExtensionContentTypeProvider () + let mimeMap = FileExtensionContentTypeProvider() /// A cache control header that instructs the browser to cache the result for no more than 30 days let cacheForThirtyDays = @@ -24,7 +24,7 @@ module private Helpers = let slash = Path.DirectorySeparatorChar /// The base directory where uploads are stored, relative to the executable - let uploadDir = Path.Combine ("wwwroot", "upload") + let uploadDir = Path.Combine("wwwroot", "upload") // ~~ SERVING UPLOADS ~~ @@ -35,10 +35,10 @@ open Microsoft.AspNetCore.Http open NodaTime /// Determine if the file has been modified since the date/time specified by the If-Modified-Since header -let checkModified since (ctx : HttpContext) : HttpHandler option = +let checkModified since (ctx: HttpContext) : HttpHandler option = match ctx.Request.Headers.IfModifiedSince with | it when it.Count < 1 -> None - | it when since > Instant.FromDateTimeUtc (DateTime.Parse (it[0], null, DateTimeStyles.AdjustToUniversal)) -> None + | it when since > Instant.FromDateTimeUtc(DateTime.Parse(it[0], null, DateTimeStyles.AdjustToUniversal)) -> None | _ -> Some (setStatusCode 304) @@ -53,29 +53,29 @@ let sendFile updatedOn path (data : byte[]) : HttpHandler = fun next ctx -> let headers = ResponseHeaders ctx.Response.Headers headers.ContentType <- (deriveMimeType >> MediaTypeHeaderValue) path headers.CacheControl <- cacheForThirtyDays - let stream = new MemoryStream (data) + let stream = new MemoryStream(data) streamData true stream None (Some (DateTimeOffset updatedOn)) next ctx open MyWebLog // GET /upload/{web-log-slug}/{**path} -let serve (urlParts : string seq) : HttpHandler = fun next ctx -> task { +let serve (urlParts: string seq) : HttpHandler = fun next ctx -> task { let webLog = ctx.WebLog let parts = (urlParts |> Seq.skip 1 |> Seq.head).Split '/' let slug = Array.head parts if slug = webLog.Slug then // Static file middleware will not work in subdirectories; check for an actual file first - let fileName = Path.Combine ("wwwroot", (Seq.head urlParts)[1..]) + let fileName = Path.Combine("wwwroot", (Seq.head urlParts)[1..]) if File.Exists fileName then return! streamFile true fileName None None next ctx else - let path = String.Join ('/', Array.skip 1 parts) + let path = String.Join('/', Array.skip 1 parts) match! ctx.Data.Upload.FindByPath path webLog.Id with | Some upload -> match checkModified upload.UpdatedOn ctx with | Some threeOhFour -> return! threeOhFour next ctx - | None -> return! sendFile (upload.UpdatedOn.ToDateTimeUtc ()) path upload.Data next ctx + | None -> return! sendFile (upload.UpdatedOn.ToDateTimeUtc()) path upload.Data next ctx | None -> return! Error.notFound next ctx else return! Error.notFound next ctx @@ -87,28 +87,27 @@ open System.Text.RegularExpressions open MyWebLog.ViewModels /// Turn a string into a lowercase URL-safe slug -let makeSlug it = ((Regex """\s+""").Replace ((Regex "[^A-z0-9 -]").Replace (it, ""), "-")).ToLowerInvariant () +let makeSlug it = (Regex """\s+""").Replace((Regex "[^A-z0-9 -]").Replace(it, ""), "-").ToLowerInvariant() // GET /admin/uploads let list : HttpHandler = requireAccess Author >=> fun next ctx -> task { let webLog = ctx.WebLog let! dbUploads = ctx.Data.Upload.FindByWebLog webLog.Id let diskUploads = - let path = Path.Combine (uploadDir, webLog.Slug) + let path = Path.Combine(uploadDir, webLog.Slug) try - Directory.EnumerateFiles (path, "*", SearchOption.AllDirectories) + Directory.EnumerateFiles(path, "*", SearchOption.AllDirectories) |> Seq.map (fun file -> let name = Path.GetFileName file let create = - match File.GetCreationTime (Path.Combine (path, file)) with + match File.GetCreationTime(Path.Combine(path, file)) with | dt when dt > DateTime.UnixEpoch -> Some dt | _ -> None { DisplayUpload.Id = "" Name = name - Path = file.Replace($"{path}{slash}", "").Replace(name, "").Replace (slash, '/') + Path = file.Replace($"{path}{slash}", "").Replace(name, "").Replace(slash, '/') UpdatedOn = create - Source = string Disk - }) + Source = string Disk }) |> List.ofSeq with | :? DirectoryNotFoundException -> [] // This is fine @@ -160,8 +159,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task { WebLogId = ctx.WebLog.Id Path = Permalink $"{year}/{month}/{fileName}" UpdatedOn = now - Data = stream.ToArray() - } + Data = stream.ToArray() } do! ctx.Data.Upload.Add file | Disk -> let fullPath = Path.Combine(uploadDir, ctx.WebLog.Slug, year, month) @@ -185,11 +183,11 @@ let deleteFromDb upId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx } /// Remove a directory tree if it is empty -let removeEmptyDirectories (webLog : WebLog) (filePath : string) = +let removeEmptyDirectories (webLog: WebLog) (filePath: string) = let mutable path = Path.GetDirectoryName filePath let mutable finished = false while (not finished) && path > "" do - let fullPath = Path.Combine (uploadDir, webLog.Slug, path) + let fullPath = Path.Combine(uploadDir, webLog.Slug, path) if Directory.EnumerateFileSystemEntries fullPath |> Seq.isEmpty then Directory.Delete fullPath path <- String.Join(slash, path.Split slash |> Array.rev |> Array.skip 1 |> Array.rev) @@ -198,7 +196,7 @@ let removeEmptyDirectories (webLog : WebLog) (filePath : string) = // POST /admin/upload/delete/{**path} let deleteFromDisk urlParts : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { let filePath = urlParts |> Seq.skip 1 |> Seq.head - let path = Path.Combine (uploadDir, ctx.WebLog.Slug, filePath) + let path = Path.Combine(uploadDir, ctx.WebLog.Slug, filePath) if File.Exists path then File.Delete path removeEmptyDirectories ctx.WebLog filePath diff --git a/src/MyWebLog/Handlers/User.fs b/src/MyWebLog/Handlers/User.fs index 9f19efe..979ad9e 100644 --- a/src/MyWebLog/Handlers/User.fs +++ b/src/MyWebLog/Handlers/User.fs @@ -11,17 +11,17 @@ open NodaTime /// Create a password hash a password for a given user let createPasswordHash user password = - PasswordHasher().HashPassword (user, password) + PasswordHasher().HashPassword(user, password) /// Verify whether a password is valid -let verifyPassword user password (ctx : HttpContext) = backgroundTask { +let verifyPassword user password (ctx: HttpContext) = backgroundTask { match user with | Some usr -> - let hasher = PasswordHasher () - match hasher.VerifyHashedPassword (usr, usr.PasswordHash, password) with + let hasher = PasswordHasher() + match hasher.VerifyHashedPassword(usr, usr.PasswordHash, password) with | PasswordVerificationResult.Success -> return Ok () | PasswordVerificationResult.SuccessRehashNeeded -> - do! ctx.Data.WebLogUser.Update { usr with PasswordHash = hasher.HashPassword (usr, password) } + do! ctx.Data.WebLogUser.Update { usr with PasswordHash = hasher.HashPassword(usr, password) } return Ok () | _ -> return Error "Log on attempt unsuccessful" | None -> return Error "Log on attempt unsuccessful" @@ -68,11 +68,10 @@ let doLogOn : HttpHandler = fun next ctx -> task { do! addMessage ctx { UserMessage.Success with Message = "Log on successful" - Detail = Some $"Welcome to {ctx.WebLog.Name}!" - } + Detail = Some $"Welcome to {ctx.WebLog.Name}!" } return! match model.ReturnTo with - | Some url -> redirectTo false url next ctx + | Some url -> redirectTo false url next ctx // TODO: change to redirectToGet? | None -> redirectToGet "admin/dashboard" next ctx | Error msg -> do! addMessage ctx { UserMessage.Error with Message = msg } @@ -105,7 +104,7 @@ let all : HttpHandler = fun next ctx -> task { } /// Show the edit user page -let private showEdit (model : EditUserModel) : HttpHandler = fun next ctx -> +let private showEdit (model: EditUserModel) : HttpHandler = fun next ctx -> hashForPage (if model.IsNew then "Add a New User" else "Edit User") |> withAntiCsrf ctx |> addToHash ViewContext.Model model @@ -141,15 +140,13 @@ let delete userId : HttpHandler = fun next ctx -> task { | Ok _ -> do! addMessage ctx { UserMessage.Success with - Message = $"User {user.DisplayName} deleted successfully" - } + Message = $"User {user.DisplayName} deleted successfully" } return! all next ctx | Error msg -> do! addMessage ctx { UserMessage.Error with Message = $"User {user.DisplayName} was not deleted" - Detail = Some msg - } + Detail = Some msg } return! all next ctx | None -> return! Error.notFound next ctx } @@ -174,7 +171,7 @@ let myInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task { // POST /admin/my-info let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task { - let! model = ctx.BindFormAsync () + let! model = ctx.BindFormAsync() let data = ctx.Data match! data.WebLogUser.FindById ctx.UserId ctx.WebLog.Id with | Some user when model.NewPassword = model.NewPasswordConfirm -> @@ -184,8 +181,7 @@ let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task { FirstName = model.FirstName LastName = model.LastName PreferredName = model.PreferredName - PasswordHash = pw - } + PasswordHash = pw } do! data.WebLogUser.Update user let pwMsg = if model.NewPassword = "" then "" else " and updated your password" do! addMessage ctx { UserMessage.Success with Message = $"Saved your information{pwMsg} successfully" } @@ -201,15 +197,15 @@ let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task { // POST /admin/settings/user/save let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { - let! model = ctx.BindFormAsync () + let! model = ctx.BindFormAsync() let data = ctx.Data let tryUser = if model.IsNew then { WebLogUser.Empty with Id = WebLogUserId.Create() WebLogId = ctx.WebLog.Id - CreatedOn = Noda.now () - } |> someTask + CreatedOn = Noda.now () } + |> someTask else data.WebLogUser.FindById (WebLogUserId model.Id) ctx.WebLog.Id match! tryUser with | Some user when model.Password = model.PasswordConfirm -> @@ -223,8 +219,7 @@ let save : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task { do! (if model.IsNew then data.WebLogUser.Add else data.WebLogUser.Update) toUpdate do! addMessage ctx { UserMessage.Success with - Message = $"""{if model.IsNew then "Add" else "Updat"}ed user successfully""" - } + Message = $"""{if model.IsNew then "Add" else "Updat"}ed user successfully""" } return! all next ctx | Some _ -> do! addMessage ctx { UserMessage.Error with Message = "The passwords did not match; nothing saved" } diff --git a/src/MyWebLog/Maintenance.fs b/src/MyWebLog/Maintenance.fs index 00a8dbc..54ab9fc 100644 --- a/src/MyWebLog/Maintenance.fs +++ b/src/MyWebLog/Maintenance.fs @@ -7,9 +7,9 @@ open MyWebLog.Data open NodaTime /// Create the web log information -let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task { +let private doCreateWebLog (args: string[]) (sp: IServiceProvider) = task { - let data = sp.GetRequiredService () + let data = sp.GetRequiredService() let timeZone = let local = TimeZoneInfo.Local.Id @@ -38,8 +38,7 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task { Slug = slug UrlBase = args[1] DefaultPage = string homePageId - TimeZone = timeZone - } + TimeZone = timeZone } // Create the admin user let now = Noda.now () @@ -52,8 +51,7 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task { LastName = "User" PreferredName = "Admin" AccessLevel = accessLevel - CreatedOn = now - } + CreatedOn = now } do! data.WebLogUser.Add { user with PasswordHash = Handlers.User.createPasswordHash user args[4] } // Create the default home page @@ -69,16 +67,14 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task { Text = "

This is your default home page.

" Revisions = [ { AsOf = now - Text = Html "

This is your default home page.

" - } - ] - } + Text = Html "

This is your default home page.

" } + ] } printfn $"Successfully initialized database for {args[2]} with URL base {args[1]}" match accessLevel with | Administrator -> printfn $" ({args[3]} is an installation administrator)" | WebLogAdmin -> - printfn $" ({args[3]} is a web log administrator;" + printfn $" ({args[3]} is a web log administrator;" printfn """ use "upgrade-user" to promote to installation administrator)""" | _ -> () } @@ -91,8 +87,8 @@ let createWebLog args sp = task { } /// Import prior permalinks from a text files with lines in the format "[old] [new]" -let private importPriorPermalinks urlBase file (sp : IServiceProvider) = task { - let data = sp.GetRequiredService () +let private importPriorPermalinks urlBase file (sp: IServiceProvider) = task { + let data = sp.GetRequiredService() match! data.WebLog.FindByHost urlBase with | Some webLog -> @@ -129,7 +125,7 @@ let importLinks args sp = task { open Microsoft.Extensions.Logging /// Load a theme from the given ZIP file -let loadTheme (args : string[]) (sp : IServiceProvider) = task { +let loadTheme (args: string[]) (sp: IServiceProvider) = task { if args.Length = 2 then let fileName = match args[1].LastIndexOf Path.DirectorySeparatorChar with @@ -137,12 +133,12 @@ let loadTheme (args : string[]) (sp : IServiceProvider) = task { | it -> args[1][(it + 1)..] match Handlers.Admin.Theme.deriveIdFromFileName fileName with | Ok themeId -> - let data = sp.GetRequiredService () - use stream = File.Open (args[1], FileMode.Open) - use copy = new MemoryStream () + let data = sp.GetRequiredService() + use stream = File.Open(args[1], FileMode.Open) + use copy = new MemoryStream() do! stream.CopyToAsync copy let! theme = Handlers.Admin.Theme.loadFromZip themeId copy data - let fac = sp.GetRequiredService () + let fac = sp.GetRequiredService() let log = fac.CreateLogger "MyWebLog.Themes" log.LogInformation $"{theme.Name} v{theme.Version} ({theme.Id}) loaded" | Error message -> eprintfn $"{message}" @@ -159,103 +155,96 @@ module Backup = /// A theme asset, with the data base-64 encoded type EncodedAsset = { /// The ID of the theme asset - Id : ThemeAssetId + Id: ThemeAssetId /// The updated date for this asset - UpdatedOn : Instant + UpdatedOn: Instant /// The data for this asset, base-64 encoded - Data : string - } + Data: string } /// Create an encoded theme asset from the original theme asset - static member fromAsset (asset : ThemeAsset) = + static member fromAsset (asset: ThemeAsset) = { Id = asset.Id UpdatedOn = asset.UpdatedOn - Data = Convert.ToBase64String asset.Data - } + Data = Convert.ToBase64String asset.Data } /// Create a theme asset from an encoded theme asset - static member toAsset (encoded : EncodedAsset) : ThemeAsset = + static member toAsset (encoded: EncodedAsset) : ThemeAsset = { Id = encoded.Id UpdatedOn = encoded.UpdatedOn - Data = Convert.FromBase64String encoded.Data - } + Data = Convert.FromBase64String encoded.Data } /// An uploaded file, with the data base-64 encoded type EncodedUpload = { /// The ID of the upload - Id : UploadId + Id: UploadId /// The ID of the web log to which the upload belongs - WebLogId : WebLogId + WebLogId: WebLogId /// The path at which this upload is served - Path : Permalink + Path: Permalink /// The date/time this upload was last updated (file time) - UpdatedOn : Instant + UpdatedOn: Instant /// The data for the upload, base-64 encoded - Data : string - } + Data: string } /// Create an encoded uploaded file from the original uploaded file - static member fromUpload (upload : Upload) : EncodedUpload = + static member fromUpload (upload: Upload) : EncodedUpload = { Id = upload.Id WebLogId = upload.WebLogId Path = upload.Path UpdatedOn = upload.UpdatedOn - Data = Convert.ToBase64String upload.Data - } + Data = Convert.ToBase64String upload.Data } /// Create an uploaded file from an encoded uploaded file - static member toUpload (encoded : EncodedUpload) : Upload = + static member toUpload (encoded: EncodedUpload) : Upload = { Id = encoded.Id WebLogId = encoded.WebLogId Path = encoded.Path UpdatedOn = encoded.UpdatedOn - Data = Convert.FromBase64String encoded.Data - } + Data = Convert.FromBase64String encoded.Data } /// A unified archive for a web log type Archive = { /// The web log to which this archive belongs - WebLog : WebLog + WebLog: WebLog /// The users for this web log - Users : WebLogUser list + Users: WebLogUser list /// The theme used by this web log at the time the archive was made - Theme : Theme + Theme: Theme /// Assets for the theme used by this web log at the time the archive was made - Assets : EncodedAsset list + Assets: EncodedAsset list /// The categories for this web log - Categories : Category list + Categories: Category list /// The tag mappings for this web log - TagMappings : TagMap list + TagMappings: TagMap list /// The pages for this web log (containing only the most recent revision) - Pages : Page list + Pages: Page list /// The posts for this web log (containing only the most recent revision) - Posts : Post list + Posts: Post list /// The uploaded files for this web log - Uploads : EncodedUpload list - } + Uploads: EncodedUpload list } /// Create a JSON serializer let private getSerializer prettyOutput = - let serializer = Json.configure (JsonSerializer.CreateDefault ()) + let serializer = Json.configure (JsonSerializer.CreateDefault()) if prettyOutput then serializer.Formatting <- Formatting.Indented serializer /// Display statistics for a backup archive - let private displayStats (msg : string) (webLog : WebLog) archive = + let private displayStats (msg: string) (webLog: WebLog) archive = let userCount = List.length archive.Users let assetCount = List.length archive.Assets @@ -280,7 +269,7 @@ module Backup = printfn $""" - {uploadCount} uploaded file{plural uploadCount "" "s"}""" /// Create a backup archive - let private createBackup webLog (fileName : string) prettyOutput (data : IData) = task { + let private createBackup webLog (fileName: string) prettyOutput (data: IData) = task { // Create the data structure printfn "- Exporting theme..." let! theme = data.Theme.FindById webLog.ThemeId @@ -312,25 +301,24 @@ module Backup = TagMappings = tagMaps Pages = pages |> List.map (fun p -> { p with Revisions = List.truncate 1 p.Revisions }) Posts = posts |> List.map (fun p -> { p with Revisions = List.truncate 1 p.Revisions }) - Uploads = uploads |> List.map EncodedUpload.fromUpload - } + Uploads = uploads |> List.map EncodedUpload.fromUpload } // Write the structure to the backup file if File.Exists fileName then File.Delete fileName let serializer = getSerializer prettyOutput - use writer = new StreamWriter (fileName) - serializer.Serialize (writer, archive) - writer.Close () + use writer = new StreamWriter(fileName) + serializer.Serialize(writer, archive) + writer.Close() displayStats $"{fileName} (for <>NAME<>) contains:" webLog archive } - let private doRestore archive newUrlBase (data : IData) = task { + let private doRestore archive newUrlBase (data: IData) = task { let! restore = task { match! data.WebLog.FindById archive.WebLog.Id with | Some webLog when defaultArg newUrlBase webLog.UrlBase = webLog.UrlBase -> do! data.WebLog.Delete webLog.Id - return { archive with WebLog = { archive.WebLog with UrlBase = defaultArg newUrlBase webLog.UrlBase } } + return { archive with Archive.WebLog.UrlBase = defaultArg newUrlBase webLog.UrlBase } | Some _ -> // Err'body gets new IDs... let newWebLogId = WebLogId.Create() @@ -354,24 +342,18 @@ module Backup = { page with Id = newPageIds[page.Id] WebLogId = newWebLogId - AuthorId = newUserIds[page.AuthorId] - }) + AuthorId = newUserIds[page.AuthorId] }) Posts = archive.Posts |> List.map (fun post -> { post with Id = newPostIds[post.Id] WebLogId = newWebLogId AuthorId = newUserIds[post.AuthorId] - CategoryIds = post.CategoryIds |> List.map (fun c -> newCatIds[c]) - }) + CategoryIds = post.CategoryIds |> List.map (fun c -> newCatIds[c]) }) Uploads = archive.Uploads - |> List.map (fun u -> { u with Id = newUpIds[u.Id]; WebLogId = newWebLogId }) - } + |> List.map (fun u -> { u with Id = newUpIds[u.Id]; WebLogId = newWebLogId }) } | None -> - return - { archive with - WebLog = { archive.WebLog with UrlBase = defaultArg newUrlBase archive.WebLog.UrlBase } - } + return { archive with Archive.WebLog.UrlBase = defaultArg newUrlBase archive.WebLog.UrlBase } } // Restore theme and assets (one at a time, as assets can be large) @@ -413,12 +395,12 @@ module Backup = } /// Decide whether to restore a backup - let private restoreBackup (fileName : string) newUrlBase promptForOverwrite data = task { + let private restoreBackup fileName newUrlBase promptForOverwrite data = task { let serializer = getSerializer false - use stream = new FileStream (fileName, FileMode.Open) - use reader = new StreamReader (stream) - use jsonReader = new JsonTextReader (reader) + use stream = new FileStream(fileName, FileMode.Open) + use reader = new StreamReader(stream) + use jsonReader = new JsonTextReader(reader) let archive = serializer.Deserialize jsonReader let mutable doOverwrite = not promptForOverwrite @@ -428,7 +410,7 @@ module Backup = printfn " theme in either case." printfn "" printf "Continue? [Y/n] " - doOverwrite <- not ((Console.ReadKey ()).Key = ConsoleKey.N) + doOverwrite <- not (Console.ReadKey().Key = ConsoleKey.N) if doOverwrite then do! doRestore archive newUrlBase data @@ -437,9 +419,9 @@ module Backup = } /// Generate a backup archive - let generateBackup (args : string[]) (sp : IServiceProvider) = task { + let generateBackup (args: string[]) (sp: IServiceProvider) = task { if args.Length > 1 && args.Length < 5 then - let data = sp.GetRequiredService () + let data = sp.GetRequiredService() match! data.WebLog.FindByHost args[1] with | Some webLog -> let fileName = @@ -459,9 +441,9 @@ module Backup = } /// Restore a backup archive - let restoreFromBackup (args : string[]) (sp : IServiceProvider) = task { + let restoreFromBackup (args: string[]) (sp: IServiceProvider) = task { if args.Length = 2 || args.Length = 3 then - let data = sp.GetRequiredService () + let data = sp.GetRequiredService() let newUrlBase = if args.Length = 3 then Some args[2] else None do! restoreBackup args[1] newUrlBase (args[0] <> "do-restore") data else @@ -472,7 +454,7 @@ module Backup = /// Upgrade a WebLogAdmin user to an Administrator user -let private doUserUpgrade urlBase email (data : IData) = task { +let private doUserUpgrade urlBase email (data: IData) = task { match! data.WebLog.FindByHost urlBase with | Some webLog -> match! data.WebLogUser.FindByEmail email webLog.Id with @@ -487,14 +469,14 @@ let private doUserUpgrade urlBase email (data : IData) = task { } /// Upgrade a WebLogAdmin user to an Administrator user if the command-line arguments are good -let upgradeUser (args : string[]) (sp : IServiceProvider) = task { +let upgradeUser (args: string[]) (sp: IServiceProvider) = task { match args.Length with - | 3 -> do! doUserUpgrade args[1] args[2] (sp.GetRequiredService ()) + | 3 -> do! doUserUpgrade args[1] args[2] (sp.GetRequiredService()) | _ -> eprintfn "Usage: myWebLog upgrade-user [web-log-url-base] [email-address]" } /// Set a user's password -let doSetPassword urlBase email password (data : IData) = task { +let doSetPassword urlBase email password (data: IData) = task { match! data.WebLog.FindByHost urlBase with | Some webLog -> match! data.WebLogUser.FindByEmail email webLog.Id with @@ -506,8 +488,8 @@ let doSetPassword urlBase email password (data : IData) = task { } /// Set a user's password if the command-line arguments are good -let setPassword (args : string[]) (sp : IServiceProvider) = task { +let setPassword (args: string[]) (sp: IServiceProvider) = task { match args.Length with - | 4 -> do! doSetPassword args[1] args[2] args[3] (sp.GetRequiredService ()) + | 4 -> do! doSetPassword args[1] args[2] args[3] (sp.GetRequiredService()) | _ -> eprintfn "Usage: myWebLog set-password [web-log-url-base] [email-address] [password]" } diff --git a/src/MyWebLog/Program.fs b/src/MyWebLog/Program.fs index 450b383..c86cf62 100644 --- a/src/MyWebLog/Program.fs +++ b/src/MyWebLog/Program.fs @@ -5,12 +5,12 @@ open Microsoft.Extensions.Logging open MyWebLog /// Middleware to derive the current web log -type WebLogMiddleware (next : RequestDelegate, log : ILogger) = +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 { + member _.InvokeAsync(ctx: HttpContext) = task { /// Create the full path of the request let path = $"{ctx.Request.Scheme}://{ctx.Request.Host.Value}{ctx.Request.Path.Value}" match WebLogCache.tryGet path with @@ -27,14 +27,14 @@ type WebLogMiddleware (next : RequestDelegate, log : ILogger) /// Middleware to check redirects for the current web log -type RedirectRuleMiddleware (next : RequestDelegate, log : ILogger) = +type RedirectRuleMiddleware(next: RequestDelegate, log: ILogger) = /// Shorthand for case-insensitive string equality 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 { - let path = ctx.Request.Path.Value.ToLower () + member _.InvokeAsync(ctx: HttpContext) = task { + let path = ctx.Request.Path.Value.ToLower() let matched = WebLogCache.redirectRules ctx.WebLog.Id |> List.tryPick (fun rule -> @@ -42,9 +42,9 @@ type RedirectRuleMiddleware (next : RequestDelegate, log : ILogger if ciEquals path urlFrom then Some urlTo else None | WebLogCache.CachedRedirectRule.RegEx (regExFrom, patternTo) -> - if regExFrom.IsMatch path then Some (regExFrom.Replace (path, patternTo)) else None) + if regExFrom.IsMatch path then Some (regExFrom.Replace(path, patternTo)) else None) match matched with - | Some url -> ctx.Response.Redirect (url, permanent = true) + | Some url -> ctx.Response.Redirect(url, permanent = true) | None -> return! next.Invoke ctx } @@ -64,39 +64,39 @@ module DataImplementation = 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 createNpgsqlDataSource (cfg: IConfiguration) = + let builder = NpgsqlDataSourceBuilder(cfg.GetConnectionString "PostgreSQL") + let _ = builder.UseNodaTime() // let _ = builder.UseLoggerFactory(LoggerFactory.Create(fun it -> it.AddConsole () |> ignore)) (builder.Build >> Configuration.useDataSource) () /// Get the configured data implementation - let get (sp : IServiceProvider) : IData = - let config = sp.GetRequiredService () + let get (sp: IServiceProvider) : IData = + let config = sp.GetRequiredService() let await it = (Async.AwaitTask >> Async.RunSynchronously) it let connStr name = config.GetConnectionString name let hasConnStr name = (connStr >> isNull >> not) name let createSQLite connStr : IData = - let log = sp.GetRequiredService> () - let conn = new SqliteConnection (connStr) + let log = sp.GetRequiredService>() + let conn = new SqliteConnection(connStr) log.LogInformation $"Using SQLite database {conn.DataSource}" await (SQLiteData.setUpConnection conn) - SQLiteData (conn, log, Json.configure (JsonSerializer.CreateDefault ())) + SQLiteData(conn, log, Json.configure (JsonSerializer.CreateDefault())) if hasConnStr "SQLite" then createSQLite (connStr "SQLite") elif hasConnStr "RethinkDB" then - let log = sp.GetRequiredService> () + let log = sp.GetRequiredService>() let _ = Json.configure Converter.Serializer let rethinkCfg = DataConfig.FromUri (connStr "RethinkDB") let conn = await (rethinkCfg.CreateConnectionAsync log) - RethinkDbData (conn, rethinkCfg, log) + RethinkDbData(conn, rethinkCfg, log) elif hasConnStr "PostgreSQL" then createNpgsqlDataSource config - use conn = Configuration.dataSource().CreateConnection () - let log = sp.GetRequiredService> () + use conn = Configuration.dataSource().CreateConnection() + let log = sp.GetRequiredService>() log.LogInformation $"Using PostgreSQL database {conn.Database}" - PostgresData (log, Json.configure (JsonSerializer.CreateDefault ())) + PostgresData(log, Json.configure (JsonSerializer.CreateDefault())) else createSQLite "Data Source=./myweblog.db;Cache=Shared" @@ -119,7 +119,7 @@ let showHelp () = printfn "upgrade-user Upgrade a WebLogAdmin user to a full Administrator" printfn " " printfn "For more information on a particular command, run it with no options." - Task.FromResult () + Task.FromResult() open System.IO @@ -146,16 +146,16 @@ let main args = opts.ExpireTimeSpan <- TimeSpan.FromMinutes 60. opts.SlidingExpiration <- true opts.AccessDeniedPath <- "/forbidden") - let _ = builder.Services.AddLogging () - let _ = builder.Services.AddAuthorization () - let _ = builder.Services.AddAntiforgery () + let _ = builder.Services.AddLogging() + let _ = builder.Services.AddAuthorization() + let _ = builder.Services.AddAntiforgery() - let sp = builder.Services.BuildServiceProvider () + let sp = builder.Services.BuildServiceProvider() let data = DataImplementation.get sp let _ = builder.Services.AddSingleton data.Serializer task { - do! data.StartUp () + do! data.StartUp() do! WebLogCache.fill data do! ThemeAssetCache.fill data } |> Async.AwaitTask |> Async.RunSynchronously @@ -166,30 +166,30 @@ let main args = // A RethinkDB connection is designed to work as a singleton let _ = builder.Services.AddSingleton data let _ = - builder.Services.AddDistributedRethinkDBCache (fun opts -> + builder.Services.AddDistributedRethinkDBCache(fun opts -> opts.TableName <- "Session" opts.Connection <- rethink.Conn) () | :? SQLiteData as sql -> // ADO.NET connections are designed to work as per-request instantiation - let cfg = sp.GetRequiredService () + let cfg = sp.GetRequiredService() let _ = - builder.Services.AddScoped (fun sp -> - let conn = new SqliteConnection (sql.Conn.ConnectionString) + builder.Services.AddScoped(fun sp -> + let conn = new SqliteConnection(sql.Conn.ConnectionString) SQLiteData.setUpConnection conn |> Async.AwaitTask |> Async.RunSynchronously conn) - let _ = builder.Services.AddScoped () |> ignore + let _ = builder.Services.AddScoped() // Use SQLite for caching as well 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 as postgres -> // ADO.NET Data Sources are designed to work as singletons - let _ = builder.Services.AddSingleton (Configuration.dataSource ()) + let _ = builder.Services.AddSingleton(Configuration.dataSource ()) let _ = builder.Services.AddSingleton postgres let _ = - builder.Services.AddSingleton (fun _ -> - Postgres.DistributedCache () :> IDistributedCache) + builder.Services.AddSingleton(fun _ -> + Postgres.DistributedCache() :> IDistributedCache) () | _ -> () @@ -197,12 +197,12 @@ let main args = opts.IdleTimeout <- TimeSpan.FromMinutes 60 opts.Cookie.HttpOnly <- true opts.Cookie.IsEssential <- true) - let _ = builder.Services.AddGiraffe () + let _ = builder.Services.AddGiraffe() // Set up DotLiquid DotLiquidBespoke.register () - let app = builder.Build () + let app = builder.Build() match args |> Array.tryHead with | Some it when it = "init" -> Maintenance.createWebLog args app.Services @@ -219,25 +219,25 @@ let main args = showHelp () | None -> task { // Load all themes in the application directory - for themeFile in Directory.EnumerateFiles (".", "*-theme.zip") do + for themeFile in Directory.EnumerateFiles(".", "*-theme.zip") do do! Maintenance.loadTheme [| ""; themeFile |] app.Services - let _ = app.UseForwardedHeaders () + let _ = app.UseForwardedHeaders() (app.Services.GetRequiredService().GetSection "CanonicalDomains").Value |> (isNull >> not) - |> function true -> app.UseCanonicalDomains () |> ignore | false -> () + |> function true -> app.UseCanonicalDomains() |> ignore | false -> () - let _ = app.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict)) - let _ = app.UseMiddleware () - let _ = app.UseMiddleware () - let _ = app.UseAuthentication () - let _ = app.UseStaticFiles () - let _ = app.UseRouting () - let _ = app.UseSession () + let _ = app.UseCookiePolicy(CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict)) + let _ = app.UseMiddleware() + let _ = app.UseMiddleware() + let _ = app.UseAuthentication() + let _ = app.UseStaticFiles() + let _ = app.UseRouting() + let _ = app.UseSession() let _ = app.UseGiraffe Handlers.Routes.endpoint - app.Run () + app.Run() } |> Async.AwaitTask |> Async.RunSynchronously