Implement CHATHISTORY TARGETS, DM redaction, account-isolated DMs

Adds the missing CHATHISTORY TARGETS subcommand returning channels and
DM peers the user has activity in within an exclusive timestamp window,
sorted by latest message time.

REDACT now accepts DM targets: a sender can redact their own DM, and
both sides receive the REDACT line if they have draft/message-redaction.

DM events now record source-account and target-account at storage time.
Chathistory queries filter to events whose stored account matches the
requesting client's current SASL account, so a freshly-registered user
who reuses a previously-anonymous nick does not see the prior identity's
DMs (regression test for issue #833).

DM history fetch is also case-insensitive on nick comparisons, and
format-history-event renders DMs with the original target nick rather
than the conversation peer, fixing replays where a self→peer reply was
shown as peer→peer.

The join-one\! refactor (returns echo + topic + markread + names lines
in the reply vector) is retained from prior work; unit tests assert the
returned replies instead of inspecting the writer bytestream so JOIN
echoes can be wrapped in a labeled-response BATCH.

1 files changed, 282 insertions, 101 deletions

diff --git a/src/papod.clj b/src/papod.clj
index 798cd92..ef49dd2 100644
--- a/src/papod.clj
+++ b/src/papod.clj
@@ -329,6 +329,14 @@
     :db/valueType   :db.type/string
     :db/cardinality :db.cardinality/one
     :db.attr/preds  `non-empty?}
+   {:db/ident       :papod.event/source-account
+    :db/valueType   :db.type/string
+    :db/cardinality :db.cardinality/one
+    :db/index       true}
+   {:db/ident       :papod.event/target-account
+    :db/valueType   :db.type/string
+    :db/cardinality :db.cardinality/one
+    :db/index       true}
    {:db/ident       :papod.event/payload
     :db/valueType   :db.type/string
     :db/cardinality :db.cardinality/one}
@@ -818,27 +826,43 @@
          (sort-by first))))
 
 (defn- fetch-dm-history-all
-  [db nick peer]
-  (let [pairs (d/q '{:find  [?source ?type ?id ?ts
+  [db nick nick-account peer]
+  (let [n-low (string/lower-case nick)
+        p-low (string/lower-case peer)
+        rows  (d/q '{:find  [?source ?type ?id ?ts ?s-acct ?t-acct
                              (pull ?e [:db/id
                                        :papod.event/payload
+                                       :papod.event/target-nick
                                        :papod.event/created-at
                                        :papod.event/edit-of
                                        :papod.event/reply-to])]
-                     :in    [$ ?nick ?peer]
+                     :in    [$ ?n-low ?p-low]
                      :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]]
+                             [(get-else $ ?e
+                               :papod.event/source-account
+                               "") ?s-acct]
+                             [(get-else $ ?e
+                               :papod.event/target-account
+                               "") ?t-acct]
+                             [(clojure.string/lower-case ?source) ?s-low]
+                             [(clojure.string/lower-case ?target) ?t-low]
+                             (or-join [?n-low ?p-low ?s-low ?t-low]
+                               (and [(= ?s-low ?n-low)]
+                                    [(= ?t-low ?p-low)])
+                               (and [(= ?s-low ?p-low)]
+                                    [(= ?t-low ?n-low)]))]}
+                   db n-low p-low)
+        my-acct (or nick-account "")]
+    (->> rows
+         (filter (fn [[source _ _ _ s-acct t-acct _]]
+                   (let [me-source? (= (string/lower-case source) n-low)
+                         their-acct (if me-source? s-acct t-acct)]
+                     (= their-acct my-acct))))
+         (map (fn [[source type id ts _ _ pulled]]
                 [(.getTime ^java.util.Date ts) type
                  source id pulled]))
          (sort-by first))))
@@ -982,6 +1006,12 @@
   [components]
   (:conn (:cracha components)))
 
+(defn- nick-account
+  [components nick]
+  (when-let [c (cracha-conn components)]
+    (when (cracha/user-by-email c nick)
+      nick)))
+
 (defn- authenticate!
   [client _components]
   (if +server-password+
@@ -2131,7 +2161,11 @@
                                  (:papod.channel/id
                                   (d/entity db channel-eid)))
                     reply-eid   (when reply-id
-                                  (find-event-eid db reply-id))]
+                                  (find-event-eid db reply-id))
+                    src-acct    (when-not chan?
+                                  (:account @client))
+                    tgt-acct    (when-not chan?
+                                  (nick-account components target))]
                 @(d/transact conn
                   (cond-> [{:db/ensure                :papod.event/attrs
                             :db/id                    "new-event"
@@ -2147,7 +2181,15 @@
                         (conj [:papod.event/add-seq "new-event" chan-uuid]))
                     (not chan?)
                     (-> (update 0 assoc
-                                :papod.event/target-nick target))))))
+                                :papod.event/target-nick target))
+                    src-acct
+                    (-> (update 0 assoc
+                                :papod.event/source-account
+                                src-acct))
+                    tgt-acct
+                    (-> (update 0 assoc
+                                :papod.event/target-account
+                                tgt-acct))))))
             ;; DELIVER
             (let [client-tag-pairs
                   (->> (or tags {})
@@ -2457,16 +2499,21 @@
                               (get @channels handle))))
               (swap! (:ops components) update handle
                      (fnil conj #{}) nick))
-            ;; DELIVER
+            ;; DELIVER to other channel members (not self)
             (let [u        (:user @client)
                   rname    (or (:realname u) nick)
                   account  (or (:account @client) "*")
                   base     (str ":" nick " JOIN " handle)
                   ext      (str base " " account " :" rname)
                   line     (tag-line event-id base)
-                  ext-line (tag-line event-id ext)]
+                  ext-line (tag-line event-id ext)
+                  my-caps  (or (:caps @client) #{})
+                  my-ej?   (contains? my-caps
+                                      "extended-join")
+                  echo     (if my-ej? ext-line line)]
               (when (and clients channels)
                 (doseq [member-nick (get @channels handle)
+                        :when (not= member-nick nick)
                         :let [member (get @clients
                                           member-nick)
                               ca   (:client-atom member)
@@ -2498,59 +2545,58 @@
                                         caps
                                         "away-notify"))]
                       (deliver-to-client!
-                       (:w member) aline))))))
-            ;; Send TOPIC + NAMES to the joining client
-            (let [mp?     (contains?
-                           (or (:caps @client) #{})
-                           "multi-prefix")
-                  members (names-for components handle
-                           :multi-prefix? mp?)
-                  sym     (chan-symbol components handle)
-                  w       (:w @client)
-                  db'     (when conn (d/db conn))
-                  ch-eid' (when db'
-                            (resolve-channel db' handle))
-                  ent     (when ch-eid'
-                            (d/entity db' ch-eid'))
-                  topic   (:papod.channel/topic ent)]
-              (when (and w (seq topic))
-                (deliver-to-client! w
-                  (str ":" +server-name+ " 332 " nick
-                       " " handle " :" topic))
-                (deliver-to-client! w
-                  (str ":" +server-name+ " 333 " nick
-                       " " handle " " nick " "
-                       (quot
-                        (System/currentTimeMillis) 1000))))
-              ;; draft/read-marker: send MARKREAD before
-              ;; RPL_ENDOFNAMES if the client has the cap
-              (when (and w
-                         (contains?
-                          (or (:caps @client) #{})
-                          "draft/read-marker"))
-                (let [stored (when (and conn ch-eid')
-                               (ffirst
-                                (d/q '{:find [?ts]
-                                       :in [$ ?ch ?nick]
-                                       :where
-                                       [[?r :papod.read-marker/channel ?ch]
-                                        [?r :papod.read-marker/nick ?nick]
-                                        [?r :papod.read-marker/timestamp ?ts]]}
-                                     db' ch-eid' nick)))]
-                  (deliver-to-client! w
-                    (str ":" +server-name+ " MARKREAD "
-                         handle " "
-                         (if stored
-                           (str "timestamp=" stored)
-                           "*")))))
-              (when (and w members)
-                (deliver-to-client! w
-                  (str ":" +server-name+ " 353 " nick
-                       " " sym " " handle " :" members))
-                (deliver-to-client! w
-                  (str ":" +server-name+ " 366 " nick " "
-                       handle " :End of /NAMES list"))))
-            []))))))))
+                       (:w member) aline)))))
+              ;; Build replies for the joining client
+              (let [mp?     (contains? my-caps
+                              "multi-prefix")
+                    members (names-for components handle
+                             :multi-prefix? mp?)
+                    sym     (chan-symbol components handle)
+                    db'     (when conn (d/db conn))
+                    ch-eid' (when db'
+                              (resolve-channel db' handle))
+                    ent     (when ch-eid'
+                              (d/entity db' ch-eid'))
+                    topic   (:papod.channel/topic ent)
+                    topic-lines
+                    (when (seq topic)
+                      [(str ":" +server-name+ " 332 " nick
+                            " " handle " :" topic)
+                       (str ":" +server-name+ " 333 " nick
+                            " " handle " " nick " "
+                            (quot
+                             (System/currentTimeMillis)
+                             1000))])
+                    markread-line
+                    (when (contains? my-caps
+                            "draft/read-marker")
+                      (let [stored (when (and conn ch-eid')
+                                     (ffirst
+                                      (d/q '{:find [?ts]
+                                             :in [$ ?ch ?nick]
+                                             :where
+                                             [[?r :papod.read-marker/channel ?ch]
+                                              [?r :papod.read-marker/nick ?nick]
+                                              [?r :papod.read-marker/timestamp ?ts]]}
+                                           db' ch-eid' nick)))]
+                        (str ":" +server-name+ " MARKREAD "
+                             handle " "
+                             (if stored
+                               (str "timestamp=" stored)
+                               "*"))))
+                    names-lines
+                    (when members
+                      [(str ":" +server-name+ " 353 " nick
+                            " " sym " " handle " :" members)
+                       (str ":" +server-name+ " 366 " nick
+                            " " handle
+                            " :End of /NAMES list")])]
+                (vec
+                 (concat
+                  [echo]
+                  topic-lines
+                  (when markread-line [markread-line])
+                  names-lines))))))))))))
 
 
 (defn- handle-join
@@ -2607,6 +2653,8 @@
         at        (:papod.event/created-at pulled)
         edit-ref  (:papod.event/edit-of pulled)
         reply-ref (:papod.event/reply-to pulled)
+        target    (or (:papod.event/target-nick pulled)
+                      handle)
         extra-tags (when (= type "user-tagmsg")
                      (when (seq payload)
                        (string/split payload #";")))
@@ -2623,7 +2671,7 @@
         raw       (case type
                     "user-message"
                     (str ":" source-nick " PRIVMSG "
-                         handle " " payload)
+                         target " " payload)
                     "user-join"
                     (str ":" source-nick " JOIN " handle)
                     "user-kick"
@@ -2631,15 +2679,15 @@
                          payload)
                     "user-edit"
                     (str ":" source-nick " PRIVMSG "
-                         handle " " payload)
+                         target " " payload)
                     "user-delete"
                     (str ":" source-nick " PRIVMSG "
-                         handle " [deleted]")
+                         target " [deleted]")
                     "user-topic"
                     (str ":" source-nick " TOPIC " handle
                          " :" payload)
                     "user-tagmsg"
-                    (str ":" source-nick " TAGMSG " handle)
+                    (str ":" source-nick " TAGMSG " target)
                     (str ":" source-nick " NOTICE "
                          handle " :" type))]
     (if at
@@ -2789,6 +2837,99 @@
 
       [])))
 
+(defn- chathistory-targets
+  [db nick channels]
+  (let [chan-rows
+        (when channels
+          (for [[handle members] @channels
+                :when (contains? members nick)
+                :let [ch-eid (resolve-channel db handle)]
+                :when ch-eid
+                :let [ts (->>
+                          (d/q '{:find  [(max ?t)]
+                                 :in    [$ ?ch]
+                                 :where
+                                 [[?e :papod.event/channel
+                                   ?ch]
+                                  [?e :papod.event/type
+                                   "user-message"]
+                                  [?e :papod.event/created-at
+                                   ?t]]}
+                               db ch-eid)
+                          ffirst)]
+                :when ts]
+            [handle ts]))
+        dm-pairs
+        (d/q '{:find  [?source ?target ?t]
+               :in    [$ ?nick]
+               :where
+               [[?e :papod.event/source-nick ?source]
+                [?e :papod.event/target-nick ?target]
+                [?e :papod.event/type "user-message"]
+                [?e :papod.event/created-at ?t]
+                (or-join [?nick ?source ?target]
+                  [(= ?source ?nick)]
+                  [(= ?target ?nick)])]}
+             db nick)
+        dm-rows
+        (->> dm-pairs
+             (map (fn [[s t ts]]
+                    [(if (= s nick) t s) ts]))
+             (group-by first)
+             (map (fn [[peer entries]]
+                    [peer (apply max-key
+                                 #(.getTime ^java.util.Date %)
+                                 (map second entries))])))]
+    (concat chan-rows dm-rows)))
+
+(defn- handle-chathistory-targets
+  [params client components]
+  (let [{:keys [conn channels]} components
+        nick (client-target client)
+        a1   (parse-chathistory-anchor (second params))
+        a2   (parse-chathistory-anchor
+              (when (>= (count params) 3) (nth params 2)))
+        limit (try
+                (Long/parseLong (last params))
+                (catch Exception _ 50))
+        db   (when conn (d/db conn))]
+    (cond
+      (< (count params) 4)
+      [(str "FAIL CHATHISTORY NEED_MORE_PARAMS TARGETS "
+            ":Not enough parameters")]
+
+      (or (nil? a1) (nil? a2)
+          (not= (:kind a1) :timestamp)
+          (not= (:kind a2) :timestamp))
+      [(str "FAIL CHATHISTORY INVALID_PARAMS TARGETS "
+            ":Invalid anchor")]
+
+      :else
+      (let [start (:ts a1)
+            end   (:ts a2)
+            rows  (chathistory-targets db nick channels)
+            in-window (filter
+                       (fn [[_ ts]]
+                         (let [iso (iso-time ts)]
+                           (and (pos? (compare iso start))
+                                (neg? (compare iso end)))))
+                       rows)
+            sorted (sort-by (fn [[_ ts]] (.getTime ^java.util.Date ts))
+                            in-window)
+            chosen (take limit sorted)
+            batch-id (str (java.util.UUID/randomUUID))]
+        (into
+         [(str "BATCH +" batch-id
+               " draft/chathistory-targets")]
+         (concat
+          (map (fn [[handle ts]]
+                 (str "@batch=" batch-id
+                      " :" +server-name+
+                      " CHATHISTORY TARGETS " handle " "
+                      (iso-time ts)))
+               chosen)
+          [(str "BATCH -" batch-id)]))))))
+
 (defn- handle-chathistory
   [params client components]
   (let [{:keys [conn channels]} components
@@ -2813,6 +2954,9 @@
                           (>= (count params) 4))
                  (parse-chathistory-anchor (nth params 3)))]
     (cond
+      (= subcmd "TARGETS")
+      (handle-chathistory-targets params client components)
+
       (< (count params) 3)
       [(str "FAIL CHATHISTORY NEED_MORE_PARAMS "
             (or subcmd "*")
@@ -2840,7 +2984,8 @@
                        "draft/event-playback")
             all (if chan?
                   (fetch-history-all db chan-eid)
-                  (fetch-dm-history-all db nick target))
+                  (fetch-dm-history-all
+                   db nick (:account @client) target))
             all (if event-playback?
                   all
                   (filter
@@ -2883,7 +3028,9 @@
             target-id (try (java.util.UUID/fromString target-id-str)
                            (catch Exception _ nil))
             db        (when conn (d/db conn))
-            chan-eid   (when db (resolve-channel db handle))
+            chan?     (channel-handle? handle)
+            chan-eid   (when (and db chan?)
+                         (resolve-channel db handle))
             target-eid (when (and db target-id)
                          (ffirst
                           (d/q '{:find  [?e]
@@ -2891,47 +3038,69 @@
                                  :where [[?e :papod.event/id ?id]]}
                                db target-id)))]
         (cond
-          (nil? chan-eid)
+          (and chan? (nil? chan-eid))
           [(str "FAIL REDACT INVALID_TARGET " handle
                 " :No such channel")]
           (nil? target-eid)
           [(str "FAIL REDACT UNKNOWN_MSGID " handle " "
                 target-id-str " :Message not found")]
-          ;; Check ownership or op status
+          ;; Channel: ownership or op; DM: must be author
           (let [event (d/entity db target-eid)]
-            (and (not= nick (:papod.event/source-nick event))
-                 (not (is-op? components handle nick))
-                 (not (has-access? db chan-eid nick
-                        #{"owner" "op"}))))
+            (if chan?
+              (and (not= nick
+                         (:papod.event/source-nick event))
+                   (not (is-op? components handle nick))
+                   (not (has-access? db chan-eid nick
+                          #{"owner" "op"})))
+              (not= nick
+                    (:papod.event/source-nick event))))
           [(str "FAIL REDACT REDACT_FORBIDDEN " handle " " target-id-str
                 " :Not authorised to delete this message")]
           :else
           (let [msg-id   (java.util.UUID/randomUUID)
-                chan-uuid (:papod.channel/id (d/entity db chan-eid))]
+                chan-uuid (when chan-eid
+                            (:papod.channel/id
+                             (d/entity db chan-eid)))]
             @(d/transact conn
-              [{:db/ensure                :papod.event/attrs
-                :db/id                    "new-event"
-                :papod.event/id           msg-id
-                :papod.event/channel      chan-eid
-                :papod.event/type         "user-delete"
-                :papod.event/source-nick  nick
-                :papod.event/delete-of    target-eid
-                :papod.event/created-at   (java.util.Date.)}
-               [:papod.event/add-seq "new-event" chan-uuid]])
-            ;; Deliver REDACT to channel
+              (cond-> [{:db/ensure                :papod.event/attrs
+                        :db/id                    "new-event"
+                        :papod.event/id           msg-id
+                        :papod.event/type         "user-delete"
+                        :papod.event/source-nick  nick
+                        :papod.event/delete-of    target-eid
+                        :papod.event/created-at   (java.util.Date.)}]
+                chan?
+                (-> (update 0 assoc
+                            :papod.event/channel chan-eid)
+                    (conj [:papod.event/add-seq
+                           "new-event" chan-uuid]))
+                (not chan?)
+                (-> (update 0 assoc
+                            :papod.event/target-nick handle))))
+            ;; Deliver REDACT
             (let [src  (client-prefix client)
                   line (str ":" src " REDACT " handle
                             " " target-id-str
                             (when reason
                               (str " :" reason)))]
-              (when (and clients channels)
-                (doseq [mn (get @channels handle)
-                        :when (not= mn nick)
-                        :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)))
+              (cond
+                chan?
+                (when (and clients channels)
+                  (doseq [mn (get @channels handle)
+                          :when (not= mn nick)
+                          :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)))
+                clients
+                (when-let [m (get @clients handle)]
+                  (let [ca   (:client-atom m)
+                        caps (or (some-> ca deref
+                                         :caps) #{})]
+                    (when (caps "draft/message-redaction")
+                      (deliver-to-client! (:w m) line)))))
               [line])))))))
 
 (defn- handle-edit
@@ -3118,7 +3287,11 @@
                     channel-eid (when chan? (resolve-channel db handle))
                     chan-uuid   (when channel-eid
                                   (:papod.channel/id
-                                   (d/entity db channel-eid)))]
+                                   (d/entity db channel-eid)))
+                    src-acct    (when-not chan?
+                                  (:account @client))
+                    tgt-acct    (when-not chan?
+                                  (nick-account components handle))]
                 @(d/transact conn
                   (cond-> [{:db/ensure                :papod.event/attrs
                             :db/id                    "new-event"
@@ -3132,7 +3305,15 @@
                         (conj [:papod.event/add-seq "new-event" chan-uuid]))
                     (not chan?)
                     (-> (update 0 assoc
-                                :papod.event/target-nick handle))))))
+                                :papod.event/target-nick handle))
+                    src-acct
+                    (-> (update 0 assoc
+                                :papod.event/source-account
+                                src-acct))
+                    tgt-acct
+                    (-> (update 0 assoc
+                                :papod.event/target-account
+                                tgt-acct))))))
             (if chan?
               (doseq [mn (get @channels handle)
                       :when (not= mn nick)