refactor: Label syntax: case-sensitive with post-bracket space

Author: bzg

docs/bark-manual.org

@@ -476,6 +476,9 @@ Reports are detected from email subject labels:
 Long-form aliases are also accepted: =[ANNOUNCEMENT]=, =[RELEASE]=,
 =[CHANGE]=.
 
+Labels are case-sensitive and require whitespace (or end of subject)
+after the closing =]=.  Malformed labels are ignored.
+
 Announcements, releases and changes require maintainer permission.
 
 All =<…>= parts are optional and positional. For release and change, a

resources/emails.edn

@@ -797,17 +797,17 @@
   :email/body-text  "Notify: d:1\n"}
 
  ;; =========================================================================
- ;; 59 — Case insensitive tag: [bug] lowercase
+ ;; 59 — Properly tagged [BUG] (anchors a thread for 61/62/64)
  ;; =========================================================================
  {
   :email/id        "59"
   :email/source     "direct"
   :email/message-id "<59@test.org>"
-  :email/subject    "[bug] lowercase tag test"
+  :email/subject    "[BUG] strict tag test"
   :email/from-address "user@test.org"
   :email/date-sent  #inst "2026-01-21T10:00:00"
   :email/ingested-at #inst "2026-01-21T10:00:00"
-  :email/body-text  "Lowercase tag.\n"}
+  :email/body-text  "Strict tag.\n"}
 
  ;; =========================================================================
  ;; 60 — [ANNOUNCEMENT] long form tag
@@ -829,7 +829,7 @@
   :email/id        "61"
   :email/source     "direct"
   :email/message-id "<61@test.org>"
-  :email/subject    "Re: [bug] lowercase tag test"
+  :email/subject    "Re: [BUG] strict tag test"
   :email/from-address "maint@test.org"
   :email/date-sent  #inst "2026-01-21T12:00:00"
   :email/ingested-at #inst "2026-01-21T12:00:00"
@@ -843,7 +843,7 @@
   :email/id        "62"
   :email/source     "direct"
   :email/message-id "<62@test.org>"
-  :email/subject    "Re: Re: [bug] lowercase tag test"
+  :email/subject    "Re: Re: [BUG] strict tag test"
   :email/from-address "maint@test.org"
   :email/date-sent  #inst "2026-01-21T13:00:00"
   :email/ingested-at #inst "2026-01-21T13:00:00"
@@ -866,15 +866,15 @@
 
  ;; =========================================================================
  ;; 64 — Duplicate report attempt (same subject tag, same thread)
- ;; Tests that a second [bug] email in the same thread doesn't create
+ ;; Tests that a second [BUG] email in the same thread doesn't create
  ;; a second report — it becomes a descendant instead.
  ;; Uses its own message-id (unlike email 59) to avoid DB-level upsert.
  ;; =========================================================================
  {
   :email/id        "64"
   :email/source     "direct"
   :email/message-id "<64@test.org>"
-  :email/subject    "[bug] lowercase tag test"
+  :email/subject    "[BUG] strict tag test"
   :email/from-address "user@test.org"
   :email/date-sent  #inst "2026-01-21T15:00:00"
   :email/ingested-at #inst "2026-01-21T15:00:00"
@@ -1838,4 +1838,30 @@
   :email/in-reply-to "<136@test.org>"
   :email/references  "<136@test.org>"
   :email/body-text  "Actually the other one was the better description.\nSuperseded-by: <135@test.org>\n"}
+
+ ;; =========================================================================
+ ;; 201 — Malformed label (lowercase): label must be case-sensitive
+ ;; Expected: no report created (regex rejects [bug])
+ ;; =========================================================================
+ {:email/id        "201"
+  :email/source      "direct"
+  :email/message-id  "<201@test.org>"
+  :email/subject     "[bug] should not match"
+  :email/from-address "user-a@test.org"
+  :email/date-sent  #inst "2026-03-09T09:00:00"
+  :email/ingested-at #inst "2026-03-09T09:00:00"
+  :email/body-text  "Lowercase tag, must not classify.\n"}
+
+ ;; =========================================================================
+ ;; 202 — Malformed label (no space after `]`): must be rejected
+ ;; Expected: no report created (regex requires \s|$ after closing bracket)
+ ;; =========================================================================
+ {:email/id        "202"
+  :email/source      "direct"
+  :email/message-id  "<202@test.org>"
+  :email/subject     "[BUG]glued subject"
+  :email/from-address "user-a@test.org"
+  :email/date-sent  #inst "2026-03-09T09:01:00"
+  :email/ingested-at #inst "2026-03-09T09:01:00"
+  :email/body-text  "Glued label, must not classify.\n"}
 ]

src/bark/detect.clj

@@ -13,11 +13,18 @@
 
 (def ^:private ml-prefix "(?:\\[[^\\]]*\\]\\s*)*")
 
-(defn compile-labels [st]
+(defn compile-labels
+  "Compile a type=>tags map into type=>regex.  The label must take a
+  strict bracket form anchored at the start of the subject: `[TAG]` or
+  `[TAG <inner>]`, with the tag matched case-sensitively against the
+  configured tokens and followed by whitespace or end-of-subject after
+  the closing `]`.  Optional mailing-list bracket prefixes (e.g.
+  `[my-list] [BUG] ...`) are tolerated."
+  [st]
   (update-vals st
                (fn [tags]
                  (let [alts (str/join "|" (map #(java.util.regex.Pattern/quote %) tags))]
-                   (re-pattern (str "(?i)^" ml-prefix "\\[(" alts ")(?:\\s+([^\\]]*))?\\]"))))))
+                   (re-pattern (str "^" ml-prefix "\\[(" alts ")(?:\\s+([^\\]]*))?\\](?=\\s|$)"))))))
 
 (def default-compiled-labels (compile-labels common/default-labels))
 

test/bark/detect_test.clj

@@ -63,3 +63,41 @@
     (is (not (detect/has-ics?
               {:email/body-text "Hello"
                :email/attachments [{:attachment/filename "doc.pdf"}]})))))
+
+;; ---------------------------------------------------------------------------
+;; Strict label regex: case-sensitive tag, mandatory `\s` or EOL after `]`
+;; ---------------------------------------------------------------------------
+
+(defn- detect-type [subject]
+  (:type (detect/detect-report {:email/subject subject})))
+
+(deftest label-regex-strict-test
+  (testing "accepted forms"
+    (is (= :bug   (detect-type "[BUG] Mon bug")))
+    (is (= :bug   (detect-type "[BUG foo] Mon bug")))
+    (is (= :bug   (detect-type "[BUG]")))
+    (is (= :bug   (detect-type "[mylist] [BUG] Mon bug")))
+    (is (= :patch (detect-type "[PATCH foo v2 1/2] Body")))
+    (is (= :request     (detect-type "[POLL] question?")))
+    (is (= :request     (detect-type "[TODO] task")))
+    (is (= :announcement (detect-type "[ANN] news")))
+    (is (= :announcement (detect-type "[ANNOUNCEMENT] news")))
+    (is (= :release  (detect-type "[REL 2.0] notes")))
+    (is (= :change   (detect-type "[CHG 9.8] heads-up"))))
+
+  (testing "rejected: wrong case"
+    (is (nil? (detect-type "[Bug] Mon bug")))
+    (is (nil? (detect-type "[bug] Mon bug")))
+    (is (nil? (detect-type "[Patch] body")))
+    (is (nil? (detect-type "[poll] question?"))))
+
+  (testing "rejected: no whitespace after closing bracket"
+    (is (nil? (detect-type "[BUG]Mon bug")))
+    (is (nil? (detect-type "[BUG foo]bar")))
+    (is (nil? (detect-type "[POLL]?"))))
+
+  (testing "rejected: malformed bracket content"
+    (is (nil? (detect-type "[BUG/RFC] Mon bug")))
+    (is (nil? (detect-type "[ BUG ] Mon bug")))
+    (is (nil? (detect-type "BUG: Mon bug")))
+    (is (nil? (detect-type "Re: [BUG] Mon bug")))))

test/bark/digest_test.clj

@@ -564,8 +564,8 @@
                              [:notify/key "direct:maint@test.org"])]
             (is (= 1 (:notify/interval-days pref)))))
 
-        ;; --- Email 59 case insensitive [bug] ---
-        (testing "Email 59 case insensitive [bug]"
+        ;; --- Email 59 properly tagged [BUG] ---
+        (testing "Email 59 properly tagged [BUG]"
           (is (= :bug (:report/type (get-report db "<59@test.org>")))))
 
         ;; --- Email 60 [ANNOUNCEMENT] long form ---
@@ -593,9 +593,15 @@
           (is (not (report-exists? db "<63@test.org>"))))
 
         ;; --- Email 64 duplicate tag ---
-        (testing "Email 64 [bug] reply creates own report"
+        (testing "Email 64 [BUG] reply creates own report"
           (is (report-exists? db "<64@test.org>")))
 
+        ;; --- Emails 201-202 malformed labels create no report ---
+        (testing "Email 201 lowercase [bug] is rejected"
+          (is (not (report-exists? db "<201@test.org>"))))
+        (testing "Email 202 glued [BUG]subject is rejected"
+          (is (not (report-exists? db "<202@test.org>"))))
+
         ;; --- Emails 65-66 HTML body fallback ---
         (testing "Emails 65-66 HTML body fallback"
           (let [r (get-report db "<65@test.org>")]