From a83767b6b5a500a3b9459a8c84ca5d7e51fd1f81 Mon Sep 17 00:00:00 2001
From: Vasily Postnicov <shamaz.mazum@gmail.com>
Date: Thu, 23 May 2024 13:42:10 +0300
Subject: [PATCH] Fix inability to open Gmail when using reduce-tracking-mode.

---
 source/mode/reduce-tracking.lisp | 33 ++++++++++++++++++++++++++------
 1 file changed, 27 insertions(+), 6 deletions(-)

diff --git a/source/mode/reduce-tracking.lisp b/source/mode/reduce-tracking.lisp
index 79628c15bde..a125c13be05 100644
--- a/source/mode/reduce-tracking.lisp
+++ b/source/mode/reduce-tracking.lisp
@@ -56,15 +56,36 @@ still being less noticeable in the crowd.")
     :export nil
     :documentation "The timezone the system had before enabling this mode.")))
 
+;; NB: QURI:URL-ENCODE-PARAMS is not applicable for filtering a
+;; query. For example, when opening Gmail a query may look like
+;; "https://accounts.google.com/ServiceLogin?service=mail&passive=XXXXXX&osid=1&continue=https://mail.google.com"
+;; and quri will percent-encode it to
+;; https://accounts.google.com/ServiceLogin?service=mail&passive=1209600&osid=1&continue=https%3A%2F%2Fmail.google.com
+;; This is incorrect and will result in inability to load the
+;; page. This function does not add an extra level of percent
+;; encoding.
+(serapeum:-> url-filter-params (string list)
+             (values string &optional))
+(defun url-filter-params (params forbidden-params)
+  "Accept a query parameters (as a string), remove parameters from a
+black list and return them back as a string."
+  (format
+   nil "~{~a~^&~}"
+   (reduce
+    (lambda (param acc)
+      (if (member (car param) forbidden-params :test #'string-equal) acc
+          (cons (format nil "~a=~a" (car param) (cdr param)) acc)))
+    (quri:url-decode-params params :lenient t)
+    :initial-value nil
+    :from-end t)))
+
 (defun strip-tracking-parameters (request-data)
   (let ((mode (find-submode 'reduce-tracking-mode)))
     (when (and mode (not (uiop:emptyp (quri:uri-query (url request-data)))))
-      (setf (quri:uri-query-params (url request-data))
-            (remove-if (rcurry #'member (query-tracking-parameters mode)
-                                          :test #'string-equal)
-                       (quri:url-decode-params (quri:uri-query (url request-data)) :lenient t)
-                       :key #'first)))
-    request-data))
+      (setf (quri:uri-query (url request-data))
+            (url-filter-params (quri:uri-query (url request-data))
+                               (query-tracking-parameters mode)))))
+  request-data)
 
 (defmethod enable ((mode reduce-tracking-mode) &key)
   (setf (old-timezone mode) (uiop:getenv "TZ")