From 30aea3336645f612a5dd7790a177bd65d58b6595 Mon Sep 17 00:00:00 2001
From: paku <paku@skyizwhite.dev>
Date: Mon, 22 Apr 2024 00:46:28 +0900
Subject: [PATCH] Add block-unsupported-browser middleware

---
 src/app.lisp                                   |  3 ++-
 src/middlewares/block-unsupported-browser.lisp | 15 +++++++++++++++
 2 files changed, 17 insertions(+), 1 deletion(-)
 create mode 100644 src/middlewares/block-unsupported-browser.lisp

diff --git a/src/app.lisp b/src/app.lisp
index 1e608ab..b1dcd8b 100644
--- a/src/app.lisp
+++ b/src/app.lisp
@@ -31,7 +31,8 @@
   (jg:install-middleware *app* mw:*public-files*)
   (jg:install-middleware *app* mw:*recovery*)
   (jg:install-middleware *app* mw:*normalize-path*)
-  (jg:install-middleware *app* mw:*accesslog*))
+  (jg:install-middleware *app* mw:*accesslog*)
+  (jg:install-middleware *app* mw:*block-unsupported-browser*))
 
 (defun update ()
   (stop)
diff --git a/src/middlewares/block-unsupported-browser.lisp b/src/middlewares/block-unsupported-browser.lisp
new file mode 100644
index 0000000..9f2ad54
--- /dev/null
+++ b/src/middlewares/block-unsupported-browser.lisp
@@ -0,0 +1,15 @@
+(defpackage #:hp/middlewares/block-unsupported-browser
+  (:use #:cl)
+  (:local-nicknames (#:re #:cl-ppcre))
+  (:export #:*block-unsupported-browser*))
+(in-package #:hp/middlewares/block-unsupported-browser)
+
+(defparameter *block-unsupported-browser*
+  (lambda (app)
+    (lambda (env)
+      (let ((user-agent (gethash "user-agent" (getf env :headers))))
+        (if (re:scan "(Firefox|SamsungBrowser)" user-agent)
+            `(:400
+              (:content-type "text/plain")
+              ("This site is not compatible with your browser. Please use Chrome, Edge, Safari, or another compatible browser."))
+            (funcall app env))))))