From 693a1df34fff13e782dc4081bf1297ebe01ad487 Mon Sep 17 00:00:00 2001
From: "Daniel J. Summers" <daniel@bitbadger.solutions>
Date: Sun, 30 Jul 2023 22:26:30 -0400
Subject: [PATCH] Redirect plain-text rules (#39)

regex still untested
---
 src/MyWebLog/Caches.fs  | 28 +++++++++++++++++++++++++++-
 src/MyWebLog/Program.fs | 25 +++++++++++++++++++++++++
 2 files changed, 52 insertions(+), 1 deletion(-)

diff --git a/src/MyWebLog/Caches.fs b/src/MyWebLog/Caches.fs
index 2c4e74b..2b66b59 100644
--- a/src/MyWebLog/Caches.fs
+++ b/src/MyWebLog/Caches.fs
@@ -65,9 +65,21 @@ open System.Collections.Concurrent
 /// settings update page</remarks>
 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
+
     /// The cache of web log details
     let mutable private _cache : WebLog list = []
 
+    /// Redirect rules with compiled regular expressions
+    let mutable private _redirectCache = ConcurrentDictionary<WebLogId, CachedRedirectRule list> ()
+
     /// Try to get the web log for the current request (longest matching URL base wins)
     let tryGet (path : string) =
         _cache
@@ -78,6 +90,16 @@ module WebLogCache =
     /// Cache the web log for a particular host
     let set webLog =
         _cache <- webLog :: (_cache |> List.filter (fun wl -> wl.Id <> webLog.Id))
+        _redirectCache[webLog.Id] <-
+            webLog.RedirectRules
+            |> List.map (fun it ->
+                let relUrl = Permalink >> WebLog.relativeUrl webLog
+                let urlTo = if it.To.Contains "://" then it.To else relUrl it.To
+                if it.IsRegex then
+                    let pattern = if it.From.StartsWith "^" then $"^{relUrl (it.From.Substring 1)}" else it.From
+                    RegEx (new Regex (pattern, RegexOptions.Compiled ||| RegexOptions.IgnoreCase), urlTo)
+                else
+                    Text (relUrl it.From, urlTo))
     
     /// Get all cached web logs
     let all () =
@@ -86,9 +108,13 @@ module WebLogCache =
     /// Fill the web log cache from the database
     let fill (data : IData) = backgroundTask {
         let! webLogs = data.WebLog.All ()
-        _cache <- webLogs
+        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)
diff --git a/src/MyWebLog/Program.fs b/src/MyWebLog/Program.fs
index cd462bb..2a94084 100644
--- a/src/MyWebLog/Program.fs
+++ b/src/MyWebLog/Program.fs
@@ -26,6 +26,30 @@ type WebLogMiddleware (next : RequestDelegate, log : ILogger<WebLogMiddleware>)
     }
 
 
+/// Middleware to check redirects for the current web log
+type RedirectRuleMiddleware (next : RequestDelegate, log : ILogger<RedirectRuleMiddleware>) =
+
+    /// Shorthand for case-insensitive string equality
+    let ciEquals str1 str2 =
+        System.String.Equals (str1, str2, System.StringComparison.InvariantCultureIgnoreCase)
+    
+    member _.InvokeAsync (ctx : HttpContext) = task {
+        let path    = ctx.Request.Path.Value.ToLower ()
+        let matched =
+            WebLogCache.redirectRules ctx.WebLog.Id
+            |> List.tryPick (fun rule ->
+                match rule with
+                | WebLogCache.CachedRedirectRule.Text (urlFrom, urlTo) ->
+                    log.LogInformation $"Checking {path} against from={urlFrom} and to={urlTo}"
+                    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)
+        match matched with
+        | Some url -> ctx.Response.Redirect (url, permanent = true)
+        | None -> return! next.Invoke ctx
+    }
+
+
 open System
 open BitBadger.Npgsql.FSharp.Documents
 open Microsoft.Extensions.DependencyInjection
@@ -207,6 +231,7 @@ let main args =
         
         let _ = app.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict))
         let _ = app.UseMiddleware<WebLogMiddleware> ()
+        let _ = app.UseMiddleware<RedirectRuleMiddleware> ()
         let _ = app.UseAuthentication ()
         let _ = app.UseStaticFiles ()
         let _ = app.UseRouting ()