;; ported-from: src/app/chat.ts
;;
;; Chat state as a projector over the room's replicated log (PROTOCOL.md v2).
;;
;; Every durable thing — messages, threads, reactions, images (by CID) — is a
;; LogOp appended to the encrypted OrbitDB log and folded into UI state here,
;; identically on every member. History IS replication: reopening the room
;; replays the local blockstore, joining replays other members'. Only ephemeral
;; traffic (hello/name identity assertions, presence, calls) still rides the live
;; sealed channels.
;;
;; Ordering: render order is (ts, hash) — deterministic everywhere with no
;; coordination. Reaction ops fold per (author, target, emoji) by Lamport clock
;; with hash tiebreak, so removals replicate exactly like adds.
;;
;; PORT NOTES
;;  - every LogOp is a WIRE shape, and every one of them is DECLARED in the
;;    registry below rather than spelled out at its call site. The `img` op is
;;    EIGHT keys plain and NINE with a thread — past `#js {}`'s eight-pair limit,
;;    where key order silently goes to hash order (dev/docs/CLJS.md) — so
;;    sueta.wire's `encode` builds every one of them by sequential unchecked-set,
;;    exactly as j/ordered did, and test/vectors/logops.json pins the bytes.
;;  - a Message is a mutable JS OBJECT — `messages` is spliced, shifted and
;;    read by index — but three of its fields stopped being message data in
;;    Phase 5b, when app/ui became a pure view over them:
;;      `reactions`  a Clojure map {emoji #{author}}. It used to be a js/Map of
;;                   emoji → {emoji, by:Set}, storing the emoji twice and
;;                   folding by mutation. CLJS map types carry the ES6 Map
;;                   surface, so `has`/`get`/`forEach` read a Clojure map
;;                   exactly as they read a js/Map — but `keys`/`values`/
;;                   `entries` hand back an ES6 ITERATOR, which is not itself
;;                   iterable, so a JS reader must use `forEach`. See the note
;;                   on msgView in test/helpers/app-fakes.mjs.
;;      `ident`      GONE. Authorship is one `_trust` map keyed by author pub
;;                   (`author-trust` below); the badge is derived at render, so
;;                   ticking "verified" moves every message's badge on the next
;;                   frame instead of mutating forty verdict objects that no
;;                   message pointed at.
;;      `img.url`    GONE. A blob URL is a RESOURCE, not message data: it lives
;;                   in `_imgUrls` keyed by CID, which is what turns newest-20
;;                   eviction into the pure set difference `image-window-plan`
;;                   now computes.
;;  - JS truthiness survives only where it means something: `w/non-empty` is the
;;    `if (s)` the originals wrote on string-or-missing fields, and it returns
;;    the string so it can feed `encode`, where nil means "omit this key".
;;  - the (clock, hash) tiebreak compares hashes with `>`: CLJS's two-argument
;;    `>` inlines to the raw JS operator, so that is JS string comparison. Equal
;;    clock AND equal hash RE-APPLIES — that is what makes replay idempotent,
;;    and projector.json's `zz` entry is the test that says so.
(ns sueta.app.chat
  (:require [ardegazu.id.identity :refer (fingerprint-of verify-assertion)]
            [ardegazu.id.profile :refer (clamp-profile)]
            [sueta.app.trust :as trust]
            [sueta.i18n :refer (t)]
            [sueta.wire :as w]
            [ardegazu.rooms.js :as j]
            [shadow.cljs.modern :refer (defclass js-await)]))

(def ^:private MAX-MESSAGES 1000)
(def ^:private MAX-IMG-BYTES (bit-shift-left 2 20)) ; 2 MiB plaintext
(def ^:private MAX-IMG-DIM 1600)
(def ^:private IMG-KEEP 20) ; newest images kept fetched + pinned per room
(def ^:private PENDING-MAX 500) ; buffered ops whose target hasn't arrived yet

;; ---- the shape registry ----------------------------------------------------
;;
;; Every JSON shape this namespace produces, declared once as an ordered vector
;; of [clojure-key wire-key]. PROTOCOL.md fixes the key order of the four wire
;; ones (the three LogOps and the live hello/name payload); the rest are internal
;; but declared alongside them because the reason to declare a shape is the same
;; either way — a list of keys in one place beats the same list spread over a
;; builder and three readers.

(def ^:private CHAT-OP
  "LogOp {t, ts, name, text, thread?}."
  [[:t "t"] [:ts "ts"] [:name "name"] [:text "text"] [:thread "thread"]])

(def ^:private REACT-OP
  "LogOp {t, ts, name, target, emoji, op}."
  [[:t "t"] [:ts "ts"] [:name "name"] [:target "target"] [:emoji "emoji"] [:op "op"]])

(def ^:private IMG-OP
  "LogOp {t, ts, name, cid, mime, bytes, w, h, thread?} — NINE keys threaded."
  [[:t "t"] [:ts "ts"] [:name "name"] [:cid "cid"] [:mime "mime"]
   [:bytes "bytes"] [:w "w"] [:h "h"] [:thread "thread"]])

(def ^:private ID-FIELDS
  "The identity binding hello/name carries: {idPub, idSig, hue?, glyph?}."
  [[:id-pub "idPub"] [:id-sig "idSig"] [:hue "hue"] [:glyph "glyph"]])

(def ^:private GREETING
  "hello/name on the live channel: {kind, name, …ID-FIELDS} — the identity keys
   are TRAILING, which is what the TypeScript's object spread after `name` did."
  (into [[:kind "kind"] [:name "name"]] ID-FIELDS))

(def ^:private ROOMSYNC
  "What on-room-sync hands app/rooms: {rooms, gone}, both still raw JS arrays."
  [[:rooms "rooms"] [:gone "gone"]])

(def ^:private MESSAGE
  "Projected state, not wire: {id, from, name, ts, text?, thread?, reactions,
   mine}. `img` is still added by mutation for an image op; `ident` is not —
   authorship lives in one `_trust` map now."
  [[:id "id"] [:from "from"] [:name "name"] [:ts "ts"] [:text "text"]
   [:thread "thread"] [:reactions "reactions"] [:mine "mine"]])

(def ^:private IMG-ATTACHMENT
  "{cid, mime, w, h, bytes, received, complete} — `expired` is added later by
   the image window, so it is not in the shape. Neither is `url`: the blob URL
   is keyed by CID in `_imgUrls`, not hung off the attachment."
  [[:cid "cid"] [:mime "mime"] [:w "w"] [:h "h"]
   [:bytes "bytes"] [:received "received"] [:complete "complete"]])

(def ^:private PEER-IDENTITY
  "A live peer's identity binding: {pub, fp, verdict, hue?, glyph?}."
  [[:pub "pub"] [:fp "fp"] [:verdict "verdict"] [:hue "hue"] [:glyph "glyph"]])

;; ---- clamps ----------------------------------------------------------------

(defn- clamp-ts
  "Timestamps come from other members and order the message list — a bogus value
   (NaN, negative, far-future) would pin a message to the top/bottom of every
   replica forever. Clamp to [0, now + 2 min of clock skew]. Clamped values
   depend on local `now`, so replicas may order a MALICIOUS message differently —
   deterministic ordering is preserved for every honest one."
  [ts now]
  (if-not (w/finite-num? ts)
    now
    (js/Math.min (js/Math.max ts 0) (+ now 120000))))

(defn- clamp-dim [x]
  (if (and (w/num? x) (> x 0) (<= x 8192)) (js/Math.round x) 1))

(defn- clamp-name
  "TS `String(name ?? \"?\").slice(0, 40)` — a non-string name is coerced, not
   dropped, so a hostile op cannot make a message render nameless."
  [name]
  (.slice (js/String (if (some? name) name "?")) 0 40))

(defn- safe-mime [mime]
  (if (identical? mime "image/webp") "image/webp" "image/jpeg"))

(def ^:private ENCODE-TRIES
  "In order: webp, then jpeg twice at falling quality. Safari ignores the webp
   request and hands back png or null, which is why each attempt re-checks the
   type it actually got."
  [["image/webp" 0.8] ["image/jpeg" 0.8] ["image/jpeg" 0.6]])

(defn reencode-image
  "Decode (incl. HEIC on Safari), downscale to ≤1600px, re-encode.
   Resolves to {:blob :w :h} — internal, never serialised."
  [file]
  (-> (js/createImageBitmap file (j/ordered "imageOrientation" "from-image"))
      (.catch
       (fn [_]
         ;; some browsers can't createImageBitmap certain formats — go through <img>
         (let [url (js/URL.createObjectURL file)]
           (-> (js/Promise.resolve nil)
               (.then (fn [_]
                        (let [img (js/Image.)]
                          (set! (.-src img) url)
                          (js-await [_ (.decode img)]
                            (js/createImageBitmap img)))))
               (.finally (fn [] (js/URL.revokeObjectURL url)))))))
      (.then
       (fn [bitmap]
         (let [scale (js/Math.min 1 (/ MAX-IMG-DIM (js/Math.max (.-width ^js bitmap) (.-height ^js bitmap))))
               w (js/Math.max 1 (js/Math.round (* (.-width ^js bitmap) scale)))
               h (js/Math.max 1 (js/Math.round (* (.-height ^js bitmap) scale)))
               canvas (js/document.createElement "canvas")]
           (set! (.-width canvas) w)
           (set! (.-height canvas) h)
           (.drawImage (.getContext canvas "2d") bitmap 0 0 w h)
           (.close ^js bitmap)
           ((fn step [i]
              (if (>= i (count ENCODE-TRIES))
                (throw (js/Error. (t "err.image-compress")))
                (let [[mime quality] (nth ENCODE-TRIES i)]
                  (js-await [blob (js/Promise. (fn [r] (.toBlob canvas r mime quality)))]
                    ;; Safari ignores webp and returns png or null — accept only
                    ;; what we asked for.
                    (if (and (some? blob)
                             (identical? (.-type ^js blob) mime)
                             (<= (.-size ^js blob) MAX-IMG-BYTES))
                      {:blob blob :w w :h h}
                      (step (inc i)))))))
            0))))))

;; A Message is
;;   {id, from, name, ts, text?, img?, thread?, reactions, mine}
;; and an ImageAttachment is
;;   {cid, mime, w, h, bytes, received, complete, expired?}
;; The message object is still mutated in place — `messages` is a JS array the
;; projector splices into — but nothing about IDENTITY or RESOURCES is on it
;; any more (see the port notes at the top).

(declare add-message! apply-react-op fold-into! apply-legacy to-message
         note-author! refresh-image-window! queue-image-fetch! id-fields
         id-map greeting)

(defclass ChatStore
  (constructor [this net log name room self]
    (unchecked-set this "messages" (array))
    (unchecked-set this "_byId" (js/Map.))
    (unchecked-set this "_net" net)
    (unchecked-set this "_log" log)
    (unchecked-set this "_name" name)
    (unchecked-set this "_live" false)
    (unchecked-set this "_sendingImage" false)
    ;; reaction folding: latest op per (author, target, emoji)
    (unchecked-set this "_rxSeen" (js/Map.))
    ;; ops that arrived before the message they reference
    (unchecked-set this "_pendingRx" (js/Map.))
    ;; lids of legacy messages authored on THIS device (app/migrate)
    (unchecked-set this "legacyMine" (js/Set.))
    ;; UI re-render hook
    (unchecked-set this "onChange" (fn [] js/undefined))
    ;; Peer display-name announcements (hello/name), for the roster
    (unchecked-set this "onPeerName" (fn [_ _] js/undefined))
    ;; Verified identity binding for a peer session (or key-change alarms)
    (unchecked-set this "onPeerIdentity" (fn [_ _] js/undefined))
    ;; LIVE incoming messages only (never mine, never replayed history)
    (unchecked-set this "onIncoming" (fn [_] js/undefined))
    ;; A peer proved it holds OUR identity key (another device of ours). Once.
    (unchecked-set this "onSelfDevice" (fn [_] js/undefined))
    ;; Identity-gated roomsync from one of our own devices. Once per peer.
    (unchecked-set this "onRoomSync" (fn [_ _] js/undefined))
    ;; same-identity device sync: verified pub per peer + in-flight verifications
    (unchecked-set this "_verifiedPub" (js/Map.))
    (unchecked-set this "_verifying" (js/Map.))
    (unchecked-set this "_selfDeviceSeen" (js/Set.)) ; announced (send-once)
    (unchecked-set this "_roomSyncSeen" (js/Set.)) ; accepted (receive-once)
    (unchecked-set this "_imgQueue" (js/Promise.resolve nil))
    ;; blob URLs by CID: a resource registry, not message data. One URL per
    ;; image however many messages carry it, and eviction is a set difference.
    (unchecked-set this "_imgUrls" (atom {}))
    ;; authorship by author pub: {pub {:name … :fp-emoji … :verified?
    ;; :key-changed?}}. ONE map for the whole room, derived into a badge at
    ;; render time.
    (unchecked-set this "_trust" (atom {}))
    (unchecked-set this "_room" room)
    ;; TS default parameter: `self: SelfAssertion | null = null`
    (unchecked-set this "_self" (if (identical? self js/undefined) nil self))))

(defn my-name [self] (unchecked-get self "_name"))

(defn set-name [self name]
  (unchecked-set self "_name" name)
  (.broadcast ^js (unchecked-get self "_net") (greeting self "name" name))
  js/undefined)

(defn mark-live
  "After the local tail is replayed: entries from now on are live."
  [self]
  (unchecked-set self "_live" true)
  js/undefined)

(defn on-channel-open
  "A member became reachable: introduce ourselves (roster identity binding)."
  [self peer]
  (.sendTo ^js (unchecked-get self "_net") peer
           (greeting self "hello" (unchecked-get self "_name")))
  js/undefined)

(defn- id-map
  "The identity fields as Clojure data — nil for an identity-less store, and a
   nil field for each optional one that is absent, so `encode` drops it. That is
   what makes `{}` (not `{idPub: null}`) the anonymous payload."
  [self]
  (when-some [me (unchecked-get self "_self")]
    (let [hue (unchecked-get me "hue")]
      {:id-pub (unchecked-get me "pub")
       :id-sig (unchecked-get me "sig")
       :hue (when (w/num? hue) hue)
       :glyph (w/non-empty (unchecked-get me "glyph"))})))

(defn- id-fields
  "Identity binding attached to hello/name so peers can verify who's talking."
  [self]
  (w/encode ID-FIELDS (id-map self)))

(defn- greeting
  "{kind, name, …idFields} — the identity keys are TRAILING, which is what the
   TypeScript's object spread after `name` produced."
  [self kind name]
  (w/encode GREETING (assoc (id-map self) :kind kind :name name)))

(defn ^boolean has-message
  "True once a message id is folded into state (dedupe checks, migrations)."
  [self id]
  (.has ^js (unchecked-get self "_byId") id))

(defn thread-replies [self root-id]
  (.filter (unchecked-get self "messages")
           (fn [m] (identical? (unchecked-get m "thread") root-id))))

(defn send-text [self text thread]
  (when-some [trimmed (w/non-empty (.trim ^string text))]
    (.catch (.append ^js (unchecked-get self "_log")
                     (w/encode CHAT-OP {:t "chat"
                                        :ts (js/Date.now)
                                        :name (unchecked-get self "_name")
                                        :text trimmed
                                        :thread (w/non-empty thread)}))
            (fn [_] nil)))
  js/undefined)

(defn toggle-reaction [self target emoji]
  (when-some [msg (.get ^js (unchecked-get self "_byId") target)]
    (let [me (unchecked-get (unchecked-get self "_log") "myAuthorId")
          has (contains? (get (unchecked-get msg "reactions") emoji) me)]
      (.catch (.append ^js (unchecked-get self "_log")
                       (w/encode REACT-OP {:t "react"
                                           :ts (js/Date.now)
                                           :name (unchecked-get self "_name")
                                           :target target
                                           :emoji emoji
                                           :op (if has "remove" "add")}))
              (fn [_] nil))))
  js/undefined)

(defn send-image
  "The single image pipeline for attach / paste / drop. Re-encodes on canvas
   (HEIC never leaves an iPhone, EXIF+GPS stripped by construction), encrypts,
   stores as unixfs blocks, logs the CID. Members fetch over bitswap."
  [self file thread]
  (if (unchecked-get self "_sendingImage")
    (js/Promise.reject (js/Error. (t "err.one-image")))
    (do
      (unchecked-set self "_sendingImage" true)
      (-> (js/Promise.resolve nil)
          (.then
           (fn [_]
             (js-await [enc (reencode-image file)]
               (let [blob (:blob enc)]
                 (if (> (.-size ^js blob) MAX-IMG-BYTES)
                   (throw (js/Error. (t "err.image-too-large")))
                   (js-await [buf (.arrayBuffer ^js blob)]
                     (let [data (js/Uint8Array. buf)]
                       (js-await [put (.putImage ^js (unchecked-get self "_log") data)]
                         (.append ^js (unchecked-get self "_log")
                                  (w/encode IMG-OP {:t "img"
                                                    :ts (js/Date.now)
                                                    :name (unchecked-get self "_name")
                                                    :cid (unchecked-get put "cid")
                                                    :mime (.-type ^js blob)
                                                    :bytes (.-length data)
                                                    :w (:w enc)
                                                    :h (:h enc)
                                                    :thread (w/non-empty thread)}))))))))))
          (.finally (fn [] (unchecked-set self "_sendingImage" false)))))))

;; ---- the projector: log entries → state ------------------------------------

(defn- ^boolean img-op-ok?
  "The image guard, spelled exactly as the original's negation. `not (<= b 0)` is
   NOT `> 0` when b is NaN, and the drop-vs-keep policy for a hostile op is the
   contract projector.json's i1–i4 pin — JSON cannot carry NaN today, but the
   guard is what would decide if the source of ops ever stopped being JSON."
  [cid bytes]
  (and (w/str? cid)
       (w/num? bytes)
       (not (<= bytes 0))
       (not (> bytes (+ MAX-IMG-BYTES 1024)))))

(defn apply-entry [self e]
  (let [op (unchecked-get e "op")
        ;; unguarded, exactly as before: a decrypted entry always carries an op,
        ;; and turning a would-be TypeError into a silent drop is a policy change
        ;; this step is not making
        kind (unchecked-get op "t")]
    (case kind
      "chat"
      (when-some [text (w/non-empty (w/oget op "text"))]
        (add-message! self (to-message self e
                                       (w/oget op "ts")
                                       (w/oget op "name")
                                       (.slice ^string text 0 8000)
                                       (w/oget op "thread"))))

      "img"
      (let [cid (w/oget op "cid")
            bytes (w/oget op "bytes")]
        (when (img-op-ok? cid bytes)
          (let [msg (to-message self e (w/oget op "ts") (w/oget op "name")
                                nil (w/oget op "thread"))]
            (unchecked-set msg "img"
                           (w/encode IMG-ATTACHMENT
                                     {:cid cid
                                      :mime (safe-mime (w/oget op "mime"))
                                      :w (clamp-dim (w/oget op "w"))
                                      :h (clamp-dim (w/oget op "h"))
                                      :bytes bytes
                                      :received 0
                                      :complete false}))
            (add-message! self msg)
            (refresh-image-window! self))))

      "react" (apply-react-op self e)

      "call"
      ;; the log op carries no prose ({t:"call",ts,name}) — this string is
      ;; generated at projection time, so each member renders their own language
      (add-message! self (to-message self e (w/oget op "ts") (w/oget op "name")
                                     (t "msg.call-started") nil))

      "legacy"
      (let [ms (w/oget op "msgs")]
        (when (w/arr? ms)
          (doseq [h (array-seq (.slice ^js ms 0 300))] (apply-legacy self h))))

      ;; "name" is reserved; names ride presence + per-op `name` fields
      nil))
  js/undefined)

(defn- ^boolean superseded?
  "Has a STRICTLY newer op for this (author, target, emoji) already been folded?

   `prev` wins only on a higher clock, or an equal clock and a higher hash. So
   an equal (clock, hash) — the same op replayed — is NOT superseded and RE-
   APPLIES, which is what makes replay idempotent; projector.json's `zz` entry
   is the case that says so, and writing this as `(when (newer? …))` with `<`
   inverts it. The hash compare is JS STRING comparison: two-argument `>`
   inlines to the raw operator."
  [prev clock hash]
  (and (some? prev)
       (or (> (:clock prev) clock)
           (and (identical? (:clock prev) clock)
                (> (:hash prev) hash)))))

(defn- ^boolean react-op-ok? [target emoji]
  (and (w/str? target) (w/str? emoji) (<= (.-length ^string emoji) 8)))

(defn- buffer-react!
  "The target has not arrived yet — replication is unordered across branches."
  [self e target]
  (let [pending ^js (unchecked-get self "_pendingRx")
        existing (.get pending target)
        q (if (some? existing) existing (array))]
    (when (and (< (.-size pending) PENDING-MAX) (< (.-length q) 64))
      (.push q e)
      (.set pending target q))))

(defn- apply-react-op [self e]
  (let [op (unchecked-get e "op")
        target (w/oget op "target")
        emoji (w/oget op "emoji")]
    (when (react-op-ok? target emoji)
      (let [msg (.get ^js (unchecked-get self "_byId") target)]
        (if (nil? msg)
          (buffer-react! self e target)
          ;; v13+ entries always carry an author id (durable or per-device); ""
          ;; still occurs for pre-v13 identity-less entries and failed key
          ;; bindings — the per-op pseudo-author can't collide with real ids
          ;; (and can't toggle).
          (let [hash (unchecked-get e "hash")
                author (or (w/non-empty (unchecked-get e "from"))
                           (str "?" (.slice ^string hash 0 8)))
                fold-key (str author "|" target "|" emoji)
                rx-seen ^js (unchecked-get self "_rxSeen")
                clock (unchecked-get e "clock")
                normalized (if (identical? (w/oget op "op") "remove") "remove" "add")]
            ;; fold by (clock, hash): a single author's ops are causally ordered,
            ;; so the latest op wins deterministically on every replica
            (when-not (superseded? (.get rx-seen fold-key) clock hash)
              (.set rx-seen fold-key {:clock clock :hash hash :op normalized})
              (fold-into! msg author emoji normalized)
              ((unchecked-get self "onChange"))))))))
  js/undefined)

(defn- fold-reaction
  "One reaction op applied to a tally, as a VALUE: {emoji #{author}} in,
   {emoji #{author}} out. The emoji is the key, so it is stored once — it used
   to be the key AND a field of the record under it — and an emoji whose last
   author leaves disappears rather than lingering as an empty set, which is the
   condition the chip row reads as \"show nothing\"."
  [reactions by emoji op]
  (if (identical? op "add")
    (update reactions emoji (fnil conj #{}) by)
    (let [left (disj (get reactions emoji) by)]
      (if (seq left)
        (assoc reactions emoji left)
        (dissoc reactions emoji)))))

(defn- fold-into!
  "…and the one place the message object is written. Kept separate from the
   fold so the RULE stays a function of two values."
  [msg by emoji op]
  (unchecked-set msg "reactions" (fold-reaction (unchecked-get msg "reactions") by emoji op))
  js/undefined)

(defn- apply-legacy [self h]
  (let [lid (w/oget h "lid")
        ts (w/oget h "ts")]
    (when (and (w/str? lid) (w/num? ts))
      (let [id (str "v1:" lid)]
        (when-not (.has ^js (unchecked-get self "_byId") id)
          (let [text (w/oget h "text")
                thread (w/oget h "thread")
                ;; a legacy Message: the SAME shape to-message builds
                msg (w/encode MESSAGE
                              {:id id
                               :from ""
                               :name (clamp-name (w/oget h "name"))
                               :ts (clamp-ts ts (js/Date.now))
                               :text (when (w/str? text) (.slice ^string text 0 8000))
                               :thread (when (w/str? thread) (str "v1:" thread))
                               :reactions {}
                               :mine (.has ^js (unchecked-get self "legacyMine") lid)})
                rx (w/oget h "rx")]
            (when (w/arr? rx)
              (doseq [pair (array-seq (.slice ^js rx 0 16))]
                (let [emoji (aget pair 0)
                      by (aget pair 1)]
                  (when (and (w/str? emoji) (<= (.-length ^string emoji) 8) (w/arr? by))
                    (doseq [peer (array-seq (.slice ^js by 0 64))]
                      (when (w/str? peer) (fold-into! msg (str "v1:" peer) emoji "add")))))))
            (add-message! self msg))))))
  js/undefined)

;; ---- images: fetch + newest-N window ---------------------------------------

(defn- img-of [m] (unchecked-get m "img"))

(defn- ^boolean windowed?
  "Still in scope for the newest-N window: an attachment, with a cid, not yet
   expired."
  [m]
  (let [img (img-of m)]
    (and (some? img)
         (some? (w/non-empty (unchecked-get img "cid")))
         (not (unchecked-get img "expired")))))

(defn image-urls
  "The blob URLs this room holds, by CID. app/msgs projects them into the view;
   nothing else may reach into the registry."
  [self]
  @(unchecked-get self "_imgUrls"))

(defn- image-window-plan
  "The newest-IMG-KEEP rule as a VALUE: which blob URLs to release, which
   attachments to expire, what to hand pruneImages, and which survivors still
   need fetching. Pure — it reads the message list and the blob registry and
   answers what to do to them, so the whole policy is one expression instead of
   three loops that each re-derive their own half of it.

   `:revoke` is a SET DIFFERENCE, and that is the point of moving blob URLs off
   the message: it names every CID the registry still holds that the window no
   longer keeps — whether it fell out of the newest-N or its message was
   dropped at the 1000-message cap — and it can never revoke a URL a surviving
   message still shows, which per-message URLs could not promise once two
   messages carried the same image."
  [messages blobs]
  (let [live (into [] (filter windowed?) (array-seq messages))
        cut (max 0 (- (count live) IMG-KEEP))
        dropped (subvec live 0 cut)
        kept (subvec live cut)
        cid-of #(unchecked-get (img-of %) "cid")
        keep-cids (mapv cid-of kept)
        held (set keep-cids)]
    {:revoke (into [] (remove held) (sort (keys blobs)))
     :expire (mapv img-of dropped)
     :keep-cids keep-cids
     :drop-cids (mapv cid-of dropped)
     :fetch (into [] (remove #(or (unchecked-get (img-of %) "complete")
                                  (contains? blobs (cid-of %))))
                  kept)}))

(defn- refresh-image-window!
  "Keep the newest IMG-KEEP images fetched; expire + unpin the rest."
  [self]
  (let [cell (unchecked-get self "_imgUrls")
        {:keys [revoke expire keep-cids drop-cids fetch]}
        (image-window-plan (unchecked-get self "messages") @cell)]
    (doseq [cid revoke]
      (js/URL.revokeObjectURL (get @cell cid))
      (swap! cell dissoc cid))
    (doseq [img expire]
      (unchecked-set img "complete" false)
      (unchecked-set img "received" 0)
      (unchecked-set img "expired" true))
    (when (seq drop-cids)
      (.pruneImages ^js (unchecked-get self "_log")
                    (js/Set. (into-array keep-cids))
                    (into-array drop-cids)))
    (doseq [m fetch] (queue-image-fetch! self m)))
  js/undefined)

(defn- queue-image-fetch! [self msg]
  (let [img (unchecked-get msg "img")]
    (unchecked-set
     self "_imgQueue"
     (.then (unchecked-get self "_imgQueue")
            (fn [_]
              (if (or (unchecked-get img "complete")
                      (unchecked-get img "expired")
                      (nil? (w/non-empty (unchecked-get img "cid"))))
                (js/Promise.resolve nil)
                ;; bitswap waits forever when nobody has the block — without a
                ;; timeout one unfetchable CID would stall this queue (and every
                ;; newer image) permanently. A timed-out image stays !complete,
                ;; so the next refresh-image-window! retries it.
                (js-await [data (.getImage ^js (unchecked-get self "_log")
                                           (unchecked-get img "cid")
                                           (js/AbortSignal.timeout 30000))]
                  ;; not fetchable (yet) or pruned meanwhile
                  (if (or (nil? data) (unchecked-get img "expired"))
                    js/undefined
                    (let [blob (js/Blob. #js [data]
                                         (j/ordered "type" (j/nn (unchecked-get img "mime") "image/jpeg")))
                          cell (unchecked-get self "_imgUrls")
                          cid (unchecked-get img "cid")]
                      ;; one URL per CID: a second message carrying the same
                      ;; image reuses it rather than leaking the first
                      (when-not (contains? @cell cid)
                        (swap! cell assoc cid (js/URL.createObjectURL blob)))
                      (unchecked-set img "received" (unchecked-get img "bytes"))
                      (unchecked-set img "complete" true)
                      ((unchecked-get self "onChange"))
                      js/undefined))))))))
  js/undefined)

;; ---- live (non-logged) payloads --------------------------------------------

(declare verify-peer-identity on-room-sync)

(defn on-message [self from raw]
  (let [p raw]
    (when (and (some? p) (j/js-object? p))
      (let [kind (unchecked-get p "kind")]
        (case kind
          "roomsync" (on-room-sync self from p)

          ("hello" "name")
          (let [name (clamp-name (unchecked-get p "name"))
                id-pub (unchecked-get p "idPub")
                id-sig (unchecked-get p "idSig")]
            ((unchecked-get self "onPeerName") from name)
            (when (and (w/str? id-pub) (w/str? id-sig))
              ;; profile accents ride along unverified-but-harmless; clamp here
              (let [prof (clamp-profile (j/ordered "hue" (unchecked-get p "hue")
                                                   "glyph" (unchecked-get p "glyph")))
                    hue (let [h (unchecked-get prof "hue")] (if (nil? h) js/undefined h))
                    glyph (let [g (unchecked-get prof "glyph")] (if (nil? g) js/undefined g))
                    verifying ^js (unchecked-get self "_verifying")
                    cell (array nil)
                    job (.finally (verify-peer-identity self from name id-pub id-sig hue glyph)
                                  (fn []
                                    ;; remember the in-flight verification: a
                                    ;; roomsync can arrive right behind the hello
                                    ;; that proves the sender, and must await it
                                    (when (identical? (.get verifying from) (aget cell 0))
                                      (.delete verifying from))))]
                (aset cell 0 job)
                (.set verifying from job))))

          nil))))
  js/undefined)

(defn- verify-peer-identity [self from name id-pub id-sig hue glyph]
  (js-await [fp (verify-assertion (unchecked-get (unchecked-get self "_room") "appSalt")
                                  (unchecked-get (unchecked-get self "_room") "roomId")
                                  from id-pub id-sig)]
    ;; forged or damaged binding — treat the peer as identity-less
    (if (nil? fp)
      js/undefined
      (do
        (.set ^js (unchecked-get self "_verifiedPub") from id-pub)
        ((unchecked-get self "onPeerIdentity") from
                                               (w/encode PEER-IDENTITY
                                                         {:pub id-pub
                                                          :fp fp
                                                          :verdict (trust/observe name id-pub)
                                                          :hue hue
                                                          :glyph glyph}))
        ;; same key as ours ⇒ our own other device. Announce once per peer
        ;; session: "name" broadcasts re-verify on every rename and must not
        ;; re-trigger.
        (let [me (unchecked-get self "_self")
              seen ^js (unchecked-get self "_selfDeviceSeen")]
          (when (and (some? me) (identical? id-pub (unchecked-get me "pub")) (not (.has seen from)))
            (.add seen from)
            ((unchecked-get self "onSelfDevice") from)))
        js/undefined))))

(defn- on-room-sync
  "Accept a room-list only from a peer whose VERIFIED identity is our own."
  [self from p]
  (let [me (unchecked-get self "_self")]
    (if (nil? me)
      (js/Promise.resolve nil)
      (let [pending (.get ^js (unchecked-get self "_verifying") from)]
        (-> (if (some? pending) (.catch pending (fn [_] nil)) (js/Promise.resolve nil))
            (.then
             (fn [_]
               ;; not our identity — drop silently
               (when (identical? (.get ^js (unchecked-get self "_verifiedPub") from) (unchecked-get me "pub"))
                 ;; defense in depth: once per peer session
                 (let [seen ^js (unchecked-get self "_roomSyncSeen")]
                   (when-not (.has seen from)
                     (.add seen from)
                     (let [rooms (unchecked-get p "rooms")
                           gone (unchecked-get p "gone")]
                       (when (w/arr? rooms)
                         ((unchecked-get self "onRoomSync") from
                                                            (w/encode ROOMSYNC
                                                                      {:rooms rooms
                                                                       :gone (if (w/arr? gone) gone (array))})))))))
               js/undefined)))))))

;; ---- internals -------------------------------------------------------------

(defn- to-message [self e ts name text thread]
  (let [from (unchecked-get e "from")]
    (w/encode MESSAGE
              {:id (unchecked-get e "hash")
               :from from
               :name (clamp-name name)
               :ts (clamp-ts ts (js/Date.now))
               :text text
               :thread (when (w/str? thread) thread)
               :reactions {}
               :mine (and (not (identical? "" from))
                          (identical? from (unchecked-get (unchecked-get self "_log") "myAuthorId")))})))

(defn- insert-index
  "Where (ts, id) belongs in a list already sorted by (ts, id) ascending.
   Scans from the END, because a message almost always belongs at or near it,
   and returns a position rather than performing the insert — the ordering rule
   is the thing worth reading, and it is the same rule on every replica."
  [messages ts id]
  (loop [i (.-length messages)]
    (if (and (> i 0)
             (let [prev (aget messages (dec i))]
               (not (or (< (unchecked-get prev "ts") ts)
                        (and (identical? (unchecked-get prev "ts") ts)
                             (< (unchecked-get prev "id") id))))))
      (recur (dec i))
      i)))

(defn- add-message! [self msg]
  (let [by-id ^js (unchecked-get self "_byId")
        id (unchecked-get msg "id")]
    (when-not (.has by-id id)
      (.set by-id id msg)
      (when (w/non-empty (unchecked-get msg "from")) (note-author! self msg))
      ;; stable insert by (ts, id) — deterministic on every replica
      (let [messages ^js (unchecked-get self "messages")]
        (.splice messages (insert-index messages (unchecked-get msg "ts") id) 0 msg)
        (when (> (.-length messages) MAX-MESSAGES)
          (let [dropped (.shift messages)]
            (.delete by-id (unchecked-get dropped "id"))
            ;; the evicted message may have been the last holder of a blob;
            ;; the window rule already answers "held but no longer kept", so
            ;; ask it rather than spelling the revocation out a second time
            (when (some? (unchecked-get dropped "img"))
              (refresh-image-window! self)))))
      ;; replay any reactions that were waiting for this message
      (let [pending ^js (unchecked-get self "_pendingRx")
            pend (.get pending id)]
        (when (some? pend)
          (.delete pending id)
          (doseq [e (array-seq pend)] (apply-react-op self e))))
      ;; notify only for genuinely fresh messages: history replicated from peers
      ;; after mark-live (a whole room on first join!) and migrated legacy ops
      ;; carry old timestamps and must not fire notifications/badges
      (when (and (unchecked-get self "_live")
                 (not (unchecked-get msg "mine"))
                 (< (- (js/Date.now) (unchecked-get msg "ts")) 120000))
        ((unchecked-get self "onIncoming") msg))
      ((unchecked-get self "onChange"))))
  js/undefined)

(def ^:private PUB-RE (js/RegExp. "^[A-Za-z0-9_-]{43}$"))

(defn- verdict-of
  "app/trust's verdict as Clojure data. `observe` keeps returning the JS object
   test/vectors/trust.json pins its key order for; this is where that stops
   being a JS object."
  [name pub]
  (let [v (trust/observe name pub)]
    {:verified? (j/truthy? (unchecked-get v "verified"))
     :key-changed? (j/truthy? (unchecked-get v "keyChanged"))}))

(defn author-trust
  "Authorship by author pub: {pub {:name … :fp-emoji … :verified? …
   :key-changed? …}}. ONE map for the room, which app/msgs derives every
   message's badge from."
  [self]
  @(unchecked-get self "_trust"))

(defn refresh-trust!
  "Re-read every known author against the local trust store — what the identity
   sheet's verify toggle calls. One swap and every message's badge is right on
   the next frame; the shape this replaced ticked a verdict object that no
   message pointed at, so nothing on screen moved until the room reopened."
  [self]
  (let [cell (unchecked-get self "_trust")
        fresh (reduce-kv (fn [acc pub e] (assoc acc pub (merge e (verdict-of (:name e) pub))))
                         {}
                         @cell)]
    (reset! cell fresh)
    ((unchecked-get self "onChange")))
  js/undefined)

(defn- note-author!
  "Log authorship is entry-signature-verified; remember its fingerprint + TOFU
   verdict ONCE per (author, display name) rather than once per message — the
   shape this replaced ran a fingerprint derivation and a localStorage TOFU
   round trip for every one of a thousand replayed messages."
  [self msg]
  (let [from (unchecked-get msg "from")
        nm (unchecked-get msg "name")
        cell (unchecked-get self "_trust")
        known (get @cell from)]
    (when (and (.test PUB-RE from) (not= (:name known) nm))
      (if (some? known)
        ;; the key is known and only the (name, key) sighting is new: the
        ;; fingerprint is a function of the key, so it does not move
        (do (swap! cell assoc from (merge known {:name nm} (verdict-of nm from)))
            ((unchecked-get self "onChange")))
        (do
          ;; claim the pub synchronously, or every message from this author
          ;; queued behind the derivation starts one of its own
          (swap! cell assoc from {:name nm})
          (-> (js/Promise.resolve nil)
              (.then (fn [_]
                       (js-await [fp (fingerprint-of from)]
                         (let [emoji (unchecked-get fp "emoji")
                               v (verdict-of nm from)]
                           ;; a newer name may have landed while this resolved;
                           ;; its verdict is the current one and must stand
                           (swap! cell update from
                                  (fn [e] (merge e {:fp-emoji emoji} (when (= (:name e) nm) v))))
                           ((unchecked-get self "onChange"))
                           js/undefined))))
              ;; no Ed25519/SubtleCrypto — render identity-less
              (.catch (fn [_] nil)))))))
  js/undefined)

;; ---- class surface ---------------------------------------------------------

(let [proto (.-prototype ChatStore)]
  (js/Object.defineProperty
   proto "myName"
   (j/ordered "get" (fn [] (this-as self (my-name self))) "configurable" true))
  (unchecked-set proto "setName" (fn [name] (this-as self (set-name self name))))
  (unchecked-set proto "markLive" (fn [] (this-as self (mark-live self))))
  (unchecked-set proto "onChannelOpen" (fn [peer] (this-as self (on-channel-open self peer))))
  (unchecked-set proto "hasMessage" (fn [id] (this-as self (has-message self id))))
  (unchecked-set proto "threadReplies" (fn [root] (this-as self (thread-replies self root))))
  (unchecked-set proto "sendText" (fn [text thread] (this-as self (send-text self text thread))))
  (unchecked-set proto "toggleReaction" (fn [target emoji] (this-as self (toggle-reaction self target emoji))))
  (unchecked-set proto "sendImage" (fn [file thread] (this-as self (send-image self file thread))))
  (unchecked-set proto "applyEntry" (fn [e] (this-as self (apply-entry self e))))
  (unchecked-set proto "onMessage" (fn [from raw] (this-as self (on-message self from raw))))
  ;; the "private" surface the tests drive (peer-kit's `_name` idiom)
  (unchecked-set proto "_idFields" (fn [] (this-as self (id-fields self))))
  (unchecked-set proto "_applyReactOp" (fn [e] (this-as self (apply-react-op self e))))
  (unchecked-set proto "_foldReaction" (fn [msg by emoji op] (fold-into! msg by emoji op)))
  (unchecked-set proto "_applyLegacy" (fn [h] (this-as self (apply-legacy self h))))
  (unchecked-set proto "_toMessage" (fn [e f] (this-as self (to-message self e
                                                                        (unchecked-get f "ts")
                                                                        (unchecked-get f "name")
                                                                        (unchecked-get f "text")
                                                                        (unchecked-get f "thread")))))
  (unchecked-set proto "_addMessage" (fn [msg] (this-as self (add-message! self msg))))
  (unchecked-set proto "_verifyPeerIdentity"
                 (fn [from name id-pub id-sig hue glyph]
                   (this-as self (verify-peer-identity self from name id-pub id-sig hue glyph))))
  (unchecked-set proto "_onRoomSync" (fn [from p] (this-as self (on-room-sync self from p)))))