Implement CHATHISTORY subcommands, TOPIC events, REDACT cap filter

Major chathistory work:
- Add CHATHISTORY BEFORE/AFTER/BETWEEN/AROUND with msgid/timestamp anchors
- Filter redacted messages from history per spec
- Persist TOPIC events for event-playback support
- Use historical timestamps in CHATHISTORY responses
- Support DM history queries (msg-to-self and between users)
- Add draft/event-playback capability

REDACT improvements:
- Only deliver REDACT to clients with draft/message-redaction cap
- Add msgid/time tags to generic TAGMSG handler
- FAIL responses include subcommand context per spec

Tag-line refactoring:
- Add tag-line-at helper for stored event timestamps
- Share msg-at between event store and broadcast in PRIVMSG/TOPIC
- Use ISO time with explicit Date instead of double iso-time call

1 files changed, 324 insertions, 73 deletions

diff --git a/src/papod.clj b/src/papod.clj
index 0f2001b..35dffdc 100644
--- a/src/papod.clj
+++ b/src/papod.clj
@@ -765,10 +765,11 @@
   (filterv (complement string/blank?) params))
 
 (defn- iso-time
-  []
-  (let [fmt (java.text.SimpleDateFormat. "yyyy-MM-dd'T'HH:mm:ss.SSS'Z'")]
-    (.setTimeZone fmt (java.util.TimeZone/getTimeZone "UTC"))
-    (.format fmt (java.util.Date.))))
+  ([] (iso-time (java.util.Date.)))
+  ([^java.util.Date d]
+   (let [fmt (java.text.SimpleDateFormat. "yyyy-MM-dd'T'HH:mm:ss.SSS'Z'")]
+     (.setTimeZone fmt (java.util.TimeZone/getTimeZone "UTC"))
+     (.format fmt d))))
 
 (defn- tag-line
   [msg-id line]
@@ -781,20 +782,71 @@
          (str ";" (string/join ";" tags)))
        " " line))
 
+(defn- tag-line-at
+  [msg-id ^java.util.Date at tags line]
+  (str "@msgid=" msg-id ";time=" (iso-time at)
+       (when (seq tags)
+         (str ";" (string/join ";" tags)))
+       " " line))
+
+(defn- fetch-history-all
+  [db channel-eid]
+  (let [redacted (->> (d/q '{:find  [?target]
+                             :in    [$ ?ch]
+                             :where [[?e :papod.event/channel ?ch]
+                                     [?e :papod.event/type "user-delete"]
+                                     [?e :papod.event/delete-of ?target]]}
+                           db channel-eid)
+                      (map first)
+                      set)]
+    (->> (d/q '{:find  [?seq ?type ?nick ?id
+                        (pull ?e [:db/id
+                                  :papod.event/payload
+                                  :papod.event/created-at
+                                  :papod.event/edit-of
+                                  :papod.event/reply-to])]
+                :in    [$ ?ch]
+                :where [[?e :papod.event/channel     ?ch]
+                        [?e :papod.event/seq         ?seq]
+                        [?e :papod.event/type        ?type]
+                        [?e :papod.event/source-nick ?nick]
+                        [?e :papod.event/id          ?id]]}
+              db channel-eid)
+         (remove (fn [[_ type _ _ pulled]]
+                   (or (= type "user-delete")
+                       (contains? redacted (:db/id pulled)))))
+         (sort-by first))))
+
+(defn- fetch-dm-history-all
+  [db nick peer]
+  (let [pairs (d/q '{:find  [?source ?type ?id ?ts
+                             (pull ?e [:db/id
+                                       :papod.event/payload
+                                       :papod.event/created-at
+                                       :papod.event/edit-of
+                                       :papod.event/reply-to])]
+                     :in    [$ ?nick ?peer]
+                     :where [[?e :papod.event/source-nick ?source]
+                             [?e :papod.event/target-nick ?target]
+                             [?e :papod.event/type ?type]
+                             [?e :papod.event/id ?id]
+                             [?e :papod.event/created-at ?ts]
+                             (or-join [?nick ?peer ?source ?target]
+                               (and [(= ?source ?nick)]
+                                    [(= ?target ?peer)])
+                               (and [(= ?source ?peer)]
+                                    [(= ?target ?nick)]))]}
+                   db nick peer)]
+    (->> pairs
+         (map (fn [[source type id ts pulled]]
+                [(.getTime ^java.util.Date ts) type
+                 source id pulled]))
+         (sort-by first))))
+
 (defn- fetch-history
   [db channel-eid after-seq limit]
-  (->> (d/q '{:find  [?seq ?type ?nick ?id (pull ?e [:papod.event/payload
-                                                     :papod.event/edit-of
-                                                     :papod.event/reply-to])]
-              :in    [$ ?ch ?after]
-              :where [[?e :papod.event/channel     ?ch]
-                      [?e :papod.event/seq         ?seq]
-                      [?e :papod.event/type        ?type]
-                      [?e :papod.event/source-nick ?nick]
-                      [?e :papod.event/id          ?id]
-                      [(> ?seq ?after)]]}
-            db channel-eid after-seq)
-       (sort-by first)
+  (->> (fetch-history-all db channel-eid)
+       (filter (fn [[seq _ _ _ _]] (> seq after-seq)))
        (take limit)))
 
 (defn- channel-handle?
@@ -1210,7 +1262,8 @@
                      " draft/read-marker"
                      " draft/message-redaction"
                      " draft/message-editing"
-                     " draft/chathistory")
+                     " draft/chathistory"
+                     " draft/event-playback")
                 (str "sasl message-tags server-time"
                      " echo-message batch"
                      " labeled-response multi-prefix"
@@ -1219,7 +1272,8 @@
                      " draft/multiline draft/read-marker"
                      " draft/message-redaction"
                      " draft/message-editing"
-                     " draft/chathistory")))])
+                     " draft/chathistory"
+                     " draft/event-playback")))])
 
       "REQ"
       (let [raw-args  (string/trim args)
@@ -1232,7 +1286,8 @@
                         "draft/multiline" "draft/read-marker"
                         "draft/message-redaction"
                         "draft/message-editing"
-                        "draft/chathistory"}]
+                        "draft/chathistory"
+                        "draft/event-playback"}]
         (if-not (every? supported requested)
           [(str ":" +server-name+ " CAP " nick
                 " NAK :" raw-args)]
@@ -1985,6 +2040,7 @@
       (let [target   (first params)
             content  (string/join " " (rest params))
             msg-id   (java.util.UUID/randomUUID)
+            msg-at   (java.util.Date.)
             chan?    (and channels (channel-handle? target))
             ;; IRCv3 +reply tag for threads
             reply-id (when-let [r (get tags "+reply")]
@@ -2050,7 +2106,7 @@
                             :papod.event/type         "user-message"
                             :papod.event/source-nick  nick
                             :papod.event/payload      content
-                            :papod.event/created-at   (java.util.Date.)}]
+                            :papod.event/created-at   msg-at}]
                     reply-eid
                     (-> (update 0 assoc :papod.event/reply-to reply-eid))
                     chan?
@@ -2075,7 +2131,7 @@
                                         client-tag-pairs)))
                   raw      (str ":" nick " PRIVMSG "
                                 target " " content)
-                  tagged   (tag-line-with msg-id out-tags raw)
+                  tagged   (tag-line-at msg-id msg-at out-tags raw)
                   text     (cond-> content
                              (string/starts-with? content ":")
                              (subs 1))
@@ -2457,6 +2513,7 @@
 (defn- format-history-event
   [handle [_ type source-nick id pulled]]
   (let [payload   (:papod.event/payload pulled)
+        at        (:papod.event/created-at pulled)
         edit-ref  (:papod.event/edit-of pulled)
         reply-ref (:papod.event/reply-to pulled)
         tags      (cond-> []
@@ -2482,45 +2539,220 @@
                     "user-delete"
                     (str ":" source-nick " PRIVMSG "
                          handle " [deleted]")
+                    "user-topic"
+                    (str ":" source-nick " TOPIC " handle
+                         " :" payload)
                     (str ":" source-nick " NOTICE "
                          handle " :" type))]
-    (tag-line-with id tags raw)))
+    (if at
+      (tag-line-at id at tags raw)
+      (tag-line-with id tags raw))))
+
+(defn- parse-chathistory-anchor
+  [s]
+  (cond
+    (= s "*")
+    {:kind :star}
+    (string/starts-with? (or s "") "msgid=")
+    (let [id-str (subs s 6)
+          id     (try (java.util.UUID/fromString id-str)
+                      (catch Exception _ nil))]
+      (when id {:kind :msgid :id id}))
+    (string/starts-with? (or s "") "timestamp=")
+    {:kind :timestamp :ts (subs s 10)}
+    :else nil))
+
+(defn- event-time-iso
+  [evt]
+  (when-let [d (:papod.event/created-at (last evt))]
+    (iso-time d)))
+
+(defn- event-msgid
+  [evt]
+  (nth evt 3))
+
+(defn- match-anchor
+  [evt anchor]
+  (case (:kind anchor)
+    :msgid     (= (event-msgid evt) (:id anchor))
+    :timestamp (= (event-time-iso evt) (:ts anchor))
+    false))
+
+(defn- before-anchor?
+  [evt anchor]
+  (case (:kind anchor)
+    :timestamp (neg? (compare (event-time-iso evt)
+                              (:ts anchor)))
+    :msgid     false
+    false))
+
+(defn- after-anchor?
+  [evt anchor]
+  (case (:kind anchor)
+    :timestamp (pos? (compare (event-time-iso evt)
+                              (:ts anchor)))
+    :msgid     false
+    false))
+
+(defn- select-events
+  [all subcmd a1 a2 limit]
+  (let [n (count all)]
+    (case subcmd
+      "LATEST"
+      (let [from (cond
+                   (= (:kind a1) :star) 0
+                   (= (:kind a1) :msgid)
+                   (or (some (fn [[i e]]
+                               (when (match-anchor e a1) (inc i)))
+                             (map-indexed vector all))
+                       0)
+                   (= (:kind a1) :timestamp)
+                   (or (some (fn [[i e]]
+                               (when (after-anchor? e a1) i))
+                             (map-indexed vector all))
+                       n)
+                   :else 0)
+            tail (subvec (vec all) from)]
+        (vec (take-last limit tail)))
+
+      "BEFORE"
+      (let [from (cond
+                   (= (:kind a1) :msgid)
+                   (some (fn [[i e]]
+                           (when (match-anchor e a1) i))
+                         (map-indexed vector all))
+                   (= (:kind a1) :timestamp)
+                   (or (some (fn [[i e]]
+                               (when-not (before-anchor? e a1) i))
+                             (map-indexed vector all))
+                       n)
+                   :else nil)]
+        (if from
+          (vec (take-last limit (subvec (vec all) 0 from)))
+          []))
+
+      "AFTER"
+      (let [from (cond
+                   (= (:kind a1) :msgid)
+                   (some (fn [[i e]]
+                           (when (match-anchor e a1) (inc i)))
+                         (map-indexed vector all))
+                   (= (:kind a1) :timestamp)
+                   (or (some (fn [[i e]]
+                               (when (after-anchor? e a1) i))
+                             (map-indexed vector all))
+                       n)
+                   :else nil)]
+        (if from
+          (vec (take limit (subvec (vec all) from)))
+          []))
+
+      "BETWEEN"
+      (let [idx (fn [a]
+                  (cond
+                    (= (:kind a) :msgid)
+                    (some (fn [[i e]]
+                            (when (match-anchor e a) i))
+                          (map-indexed vector all))
+                    (= (:kind a) :timestamp)
+                    (some (fn [[i e]]
+                            (when-not (before-anchor? e a) i))
+                          (map-indexed vector all))
+                    :else nil))
+            i1  (idx a1)
+            i2  (idx a2)
+            lo  (when (and i1 i2) (min i1 i2))
+            hi  (when (and i1 i2) (max i1 i2))
+            forward? (and i1 i2 (<= i1 i2))]
+        (if (and lo hi (< lo hi))
+          (let [slice (subvec (vec all) (inc lo) hi)]
+            (if forward?
+              (vec (take limit slice))
+              (vec (take-last limit slice))))
+          []))
+
+      "AROUND"
+      (let [idx (cond
+                  (= (:kind a1) :msgid)
+                  (some (fn [[i e]]
+                          (when (match-anchor e a1) i))
+                        (map-indexed vector all))
+                  (= (:kind a1) :timestamp)
+                  (some (fn [[i e]]
+                          (when-not (before-anchor? e a1) i))
+                        (map-indexed vector all))
+                  :else nil)]
+        (if idx
+          (let [half (quot limit 2)
+                lo   (max 0 (- idx half))
+                hi   (min n (+ lo limit))]
+            (vec (subvec (vec all) lo hi)))
+          []))
+
+      [])))
 
 (defn- handle-chathistory
   [params client components]
-  (let [{:keys [conn]} components
-        nick    (client-target client)
-        subcmd  (when (seq params)
-                  (string/upper-case (first params)))
-        target  (second params)
-        db      (when conn (d/db conn))
-        chan-eid (when (and db target)
-                  (resolve-channel db target))]
+  (let [{:keys [conn channels]} components
+        nick   (client-target client)
+        subcmd (when (seq params)
+                 (string/upper-case (first params)))
+        target (second params)
+        db     (when conn (d/db conn))
+        chan?  (and target (channel-handle? target))
+        chan-eid (when (and db target chan?)
+                  (resolve-channel db target))
+        joined? (and chan? channels
+                     (contains? (get @channels target)
+                                nick))
+        limit (try
+                (Long/parseLong (last params))
+                (catch Exception _ 50))
+        between? (= subcmd "BETWEEN")
+        a1     (when (>= (count params) 3)
+                 (parse-chathistory-anchor (nth params 2)))
+        a2     (when (and between?
+                          (>= (count params) 4))
+                 (parse-chathistory-anchor (nth params 3)))]
     (cond
       (< (count params) 3)
       [(str "FAIL CHATHISTORY NEED_MORE_PARAMS "
-            ":Not enough parameters")]
+            (or subcmd "*")
+            " :Not enough parameters")]
 
-      (nil? chan-eid)
+      (or (and chan? (nil? chan-eid))
+          (and chan? (not joined?)))
       [(str "FAIL CHATHISTORY INVALID_TARGET "
+            subcmd " "
             (or target "*") " :No such channel")]
 
+      (nil? a1)
+      [(str "FAIL CHATHISTORY INVALID_PARAMS "
+            subcmd " "
+            (or target "*") " :Invalid anchor")]
+
+      (and between? (nil? a2))
+      [(str "FAIL CHATHISTORY INVALID_PARAMS "
+            subcmd " "
+            (or target "*") " :Invalid anchor")]
+
       :else
-      (let [limit (try
-                    (Long/parseLong (last params))
-                    (catch Exception _ 50))
-            event-playback?
+      (let [event-playback?
             (contains? (or (:caps @client) #{})
                        "draft/event-playback")
-            all-events (fetch-history db chan-eid 0 limit)
-            events (if event-playback?
-                     all-events
-                     (filter
-                      (fn [[_ type & _]]
-                        (#{"user-message"
-                           "user-edit"
-                           "user-delete"} type))
-                      all-events))
+            all (if chan?
+                  (fetch-history-all db chan-eid)
+                  (fetch-dm-history-all db nick target))
+            all (if event-playback?
+                  all
+                  (filter
+                   (fn [[_ type & _]]
+                     (#{"user-message"
+                        "user-edit"
+                        "user-delete"} type))
+                   all))
+            events (select-events
+                    all subcmd a1 a2 limit)
             batch-id (str (java.util.UUID/randomUUID))]
         (into
          [(str "BATCH +" batch-id " chathistory "
@@ -2530,7 +2762,7 @@
                  (str "@batch=" batch-id ";"
                       (subs (format-history-event
                              target evt)
-                            1)))  ;; strip leading @
+                            1)))
                events)
           [(str "BATCH -" batch-id)]))))))
 
@@ -2597,8 +2829,10 @@
               (when (and clients channels)
                 (doseq [mn (get @channels handle)
                         :when (not= mn nick)
-                        :let [m (get @clients mn)]
-                        :when m]
+                        :let [m  (get @clients mn)
+                              ca (when m (:client-atom m))
+                              caps (or (some-> ca deref :caps) #{})]
+                        :when (and m (caps "draft/message-redaction"))]
                   (deliver-to-client! (:w m) line)))
               [line])))))))
 
@@ -2754,10 +2988,8 @@
                                      (string/starts-with? k "+")))
                            (map (fn [[k v]] (str k "=" v))))
             base-line (str ":" nick " TAGMSG " handle)
-            recip-line (if (seq user-tags)
-                         (str "@" (string/join ";" user-tags)
-                              " " base-line)
-                         base-line)
+            msg-id    (java.util.UUID/randomUUID)
+            tagged    (tag-line-with msg-id user-tags base-line)
             my-caps (or (:caps @client) #{})
             tags-cap? (contains? my-caps "message-tags")
             recipient-exists?
@@ -2777,23 +3009,22 @@
 
           :else
           (do
-            (when tags-cap?
-              (if chan?
-                (doseq [mn (get @channels handle)
-                        :when (not= mn nick)
-                        :let [m (get @clients mn)
-                              ca (when m (:client-atom m))
-                              caps (when ca (or (:caps @ca) #{}))]
-                        :when (and m (caps "message-tags"))]
-                  (deliver-to-client! (:w m) recip-line))
-                (when-let [m (get @clients handle)]
-                  (let [ca   (:client-atom m)
-                        caps (when ca (or (:caps @ca) #{}))]
-                    (when (caps "message-tags")
-                      (deliver-to-client! (:w m) recip-line))))))
+            (if chan?
+              (doseq [mn (get @channels handle)
+                      :when (not= mn nick)
+                      :let [m (get @clients mn)
+                            ca (when m (:client-atom m))
+                            caps (when ca (or (:caps @ca) #{}))]
+                      :when (and m (caps "message-tags"))]
+                (deliver-to-client! (:w m) tagged))
+              (when-let [m (get @clients handle)]
+                (let [ca   (:client-atom m)
+                      caps (when ca (or (:caps @ca) #{}))]
+                  (when (caps "message-tags")
+                    (deliver-to-client! (:w m) tagged)))))
             (if (and (contains? my-caps "echo-message")
                      tags-cap?)
-              [recip-line]
+              [tagged]
               [])))))))
 
 (defn- handle-markread
@@ -2920,19 +3151,39 @@
                         (string/starts-with? new-topic ":")
                         (subs 1))
             db        (when conn (d/db conn))
-            ch-eid    (when db (resolve-channel db handle))]
+            ch-eid    (when db (resolve-channel db handle))
+            chan-uuid (when ch-eid
+                        (:papod.channel/id
+                         (d/entity db ch-eid)))
+            msg-id    (java.util.UUID/randomUUID)
+            msg-at    (java.util.Date.)]
         (when ch-eid
           @(d/transact conn
             [[:db/add ch-eid :papod.channel/topic
-              new-topic]]))
+              new-topic]
+             {:db/ensure                :papod.event/attrs
+              :db/id                    "topic-event"
+              :papod.event/id           msg-id
+              :papod.event/channel      ch-eid
+              :papod.event/type         "user-topic"
+              :papod.event/source-nick  nick
+              :papod.event/payload      new-topic
+              :papod.event/created-at   msg-at}
+             [:papod.event/add-seq "topic-event" chan-uuid]]))
         ;; Notify all channel members
-        (let [line (str ":" nick " TOPIC " handle " :"
-                        new-topic)]
+        (let [raw  (str ":" nick " TOPIC " handle " :"
+                        new-topic)
+              line (tag-line-at msg-id msg-at [] raw)]
           (when (and clients channels)
             (doseq [mn (get @channels handle)
-                    :let [m (get @clients mn)]
+                    :let [m (get @clients mn)
+                          ca (when m (:client-atom m))
+                          caps (or (some-> ca deref :caps) #{})]
                     :when m]
-              (deliver-to-client! (:w m) line))))
+              (if (or (caps "message-tags")
+                      (caps "server-time"))
+                (deliver-to-client! (:w m) line)
+                (deliver-to-client! (:w m) raw)))))
         []))))
 
 (defn- handle-kick