;; ported-from: src/selfsync.ts @ v1.2.0
;;
;; Multi-device self-sync: the optional profile/app/apps sections that ride the
;; `fsync` envelope next to the friend-list `soc` blob. Old kits read only
;; `body.soc` and ignore the rest — same EnvType, same schema, purely
;; additive. Content comes from OUR OWN other devices (the agent's
;; self-origin guard), so sanitizing here is shape hygiene, not trust.
;;
;; `sanitizeProfileSync`/`foldProfileSync` and `sanitizeAppsSync`/`foldAppsSync`
;; are all public API — the hub calls the folds directly on its own stored
;; record — so JS objects go in and JS objects come out, and each section shape
;; is declared once, below, instead of being spelled out at each of the sites
;; that used to build it.
;;
;; The two sections are NOT the same shape and fold by different rules. The
;; profile is ONE snapshot with one `ts`: newest wins wholesale. `apps` is the
;; identity record's per-app map (`{<appKey>: {state, ts}}`, id-kit's tenth
;; field) — every app writes its own key and reads all of them, so it folds
;; PER KEY: a chat edit on the phone and a board edit on the laptop are two
;; independent facts and neither may erase the other.
(ns ardegazu.social.selfsync
  (:require [ardegazu.id.profile :as id-profile]
            [ardegazu.social.canon :as canon])
  (:require-macros [ardegazu.social.macros :refer [obj oget]]))

(def ^:private lang-re #"^[a-zA-Z]{2,3}(-[a-zA-Z0-9]{2,8})?$")

;; The PROFILE section's tolerance for a clock ahead of ours (mirrors friends'
;; clamp-ts). Deployed and pinned by golden vectors. The `apps` section
;; deliberately does not use it — see `sanitize-entry`.
(def ^:private SKEW-MS 120000)

(defn- js-null?
  "`x === null`, which is NOT `nil?` — ClojureScript's nil? is `== null` and so
  also answers true for an ABSENT field. The distinction is deployed
  behaviour: `blank?` below calls a profile blank only when its three optional
  fields are explicitly null, and foldProfileSync is public, so the objects it
  is handed are whatever shape a caller built."
  [x]
  (identical? x nil))

(defn sanitize-profile-sync
  "Shape-check + clamp one untrusted profile section into a fresh object, or null."
  [p]
  (if (or (nil? p) (not (identical? (js* "typeof ~{}" p) "object")))
    nil
    (let [ts-raw (oget p "ts")]
      (if (or (not (number? ts-raw)) (not (js/Number.isFinite ts-raw)))
        nil
        ;; clampProfile owns name/hue/glyph (trim, 32 code points, 0..359, one
        ;; glyph) and always returns all four keys as null rather than absent;
        ;; `lang` is re-derived here because the section's grammar is its own
        (let [prof (id-profile/clamp-profile p)
              lang-raw (oget p "lang")]
          (obj "name" (oget prof "name")
               "hue" (oget prof "hue")
               "glyph" (oget prof "glyph")
               "lang" (if (and (string? lang-raw) (.test lang-re lang-raw)) lang-raw nil)
               "ts" (js/Math.min (js/Math.max ts-raw 0) (+ (js/Date.now) SKEW-MS))))))))

(defn- blank?
  "Nothing but an empty shell — an empty name and three explicit nulls."
  [p]
  (and (identical? (oget p "name") "")
       (js-null? (oget p "hue"))
       (js-null? (oget p "glyph"))
       (js-null? (oget p "lang"))))

(defn- kept
  "`base`'s value for `k` unless it is that field's blank, in which case
  `fill`'s. The blank for `name` is the empty string; for the optional fields
  it is an explicit null."
  [base fill k blank]
  (let [v (oget base k)]
    (if (identical? v blank) (oget fill k) v)))

(defn- backfill
  "`base` with every blank field refilled from `fill`. `base`'s ts always
  survives — the timestamp belongs to the snapshot, not to the fields."
  [base fill]
  (obj "name" (kept base fill "name" "")
       "hue" (kept base fill "hue" nil)
       "glyph" (kept base fill "glyph" nil)
       "lang" (kept base fill "lang" nil)
       "ts" (oget base "ts")))

(defn fold-profile-sync
  "Fold two devices' profile snapshots: strictly newer wins wholesale;
  otherwise the remote only backfills locally-blank fields and the local ts
  stays. Commutative-converging and idempotent. A BLANK remote never wins
  wholesale no matter its ts — a fresh device's empty import must not
  clobber a real profile."
  [local remote]
  (let [lts (oget local "ts")
        rts (oget remote "ts")]
    (cond
      (and (> rts lts) (not (blank? remote)))
      ;; wholesale: a straight copy, so any key the caller carries beyond the
      ;; declared five rides along exactly as it did before
      (js/Object.assign (js-obj) remote)

      ;; equal-ts tiebreak: two devices edited in the same millisecond must
      ;; still converge — the greater canonical serialization wins (backfilled
      ;; from the loser), picked role-independently so both sides compute the
      ;; same blob; a winning blank still can't clobber (backfill refills all
      ;; its fields)
      (and (identical? rts lts)
           (not (identical? (canon/canon remote) (canon/canon local))))
      (if (pos? (compare (canon/canon remote) (canon/canon local)))
        (backfill remote local)
        (backfill local remote))

      :else
      (backfill local remote))))

;; ---- the `apps` section ------------------------------------------------------
;;
;; `{<appKey>: {state, ts}}` — the suite identity record's per-app map. Each app
;; owns exactly one key and writes only that one; every app may read all of
;; them. `state` is the app's own blob and is OPAQUE here: the kit checks that
;; it can be serialized and that it is not enormous, and looks no further.
;;
;; No entry-count cap and no eviction, deliberately. Every other clamp in this
;; kit bounds UNTRUSTED input (a friend's beacon, a stranger's envelope); this
;; map is the user's own data arriving from the user's own device, and a kit
;; that silently dropped the ninth app's section would be losing state nobody
;; can get back.
;;
;; SIZE is bounded, and the bound is id-kit's, not this kit's. id-kit owns the
;; record; the numbers below are copied from it and must not drift. What keeps
;; one app from making the fsync unsendable for the others is the WHOLE-MAP cap
;; (APPS-MAX): the section can never exceed it however many apps write, so the
;; fsync body's `apps` field has a fixed ceiling. The per-entry cap alone never
;; gave that — n apps at the per-entry cap is n times it.
;;
;; Neither cap is a cap on user history, which the house rule forbids. They
;; mirror a fixed external constraint: the suite identity record lives in ONE
;; 128 KiB localStorage entry on the apex origin, and this slot holds DIRECTORY
;; METADATA only — the little index an app publishes for the rest of the suite
;; to act on. History does not live here and must not be put here.

(def ^:private app-key-re #"^[a-z0-9-]{1,32}$")

;; UNITS. A size here is the number of UTF-16 CODE UNITS in the JSON
;; serialization — `(.-length (js/JSON.stringify x))` — never UTF-8 bytes. The
;; two agree for ASCII and diverge above U+007F (a Romanian "ș" is one code
;; unit and two bytes), and the suite is en/ro/hu, so they diverge for ordinary
;; content. Measuring bytes here while id-kit measured code units is not a
;; rounding difference, it is silent cross-device data loss: id-kit accepts and
;; persists the section, this kit's sanitizer then answers null for it, and the
;; section saves locally and never travels. Same unit, same number, both kits.
(def ^:private STATE-MAX 16384)  ; id-kit MAX-APP-STATE-BYTES, per entry's `state`
(def ^:private APPS-MAX 98304)   ; id-kit MAX-APPS-BYTES, the serialized map

(defn- plain-object?
  "A non-null JS object that is not an array. Arrays are rejected outright:
  their numeric keys would otherwise pass the key charset check."
  [v]
  (and (some? v)
       (identical? (js* "typeof ~{}" v) "object")
       (not (js/Array.isArray v))))

(defn- state-ok?
  "Serializable, both ways, and inside the per-entry size cap.

  BOTH serializers, because they disagree: JSON.stringify DROPS a
  function-valued key while canon() THROWS on one — and canon() is what the
  agent's sync fingerprint runs over one call later, so a state that only
  JSON.stringify accepts would take the entire sync down instead of losing one
  section. The cap is measured on JSON.stringify's UTF-16 code units, which is
  what id-kit measures (see UNITS above)."
  [state]
  (try
    (let [s (js/JSON.stringify state)]
      (and (string? s)
           (<= (.-length s) STATE-MAX)
           (string? (canon/canon state))))
    (catch :default _ false))) ; cycle, bigint, symbol — not a section

(defn- sanitize-entry
  "One `{state, ts}` section into a fresh object, or nil. `state` rides through
  by reference — it is the app's own value and re-serializing it would be a
  copy, not a check.

  `ts` is a real positive timestamp clamped to NOW, never to now + SKEW-MS.
  Minting a timestamp from the future is not a clamp, it is a poisoning: the
  device that did it would reject every honest remote edit of that key forever
  while broadcasting a perpetually-fresh `now + SKEW` that beats every other
  device — and, because the emitted value moves with the clock, the agent's
  sync fingerprint would differ every round and deposit a mailbox drop every
  cycle. Clamping to now leaves honest entries (ts <= now) untouched, pulls a
  future-dated one back to the present exactly once, and the receive path
  stores the clamped value, so it does not re-clamp on the next hop.

  `sanitizeProfileSync` above still clamps to now + SKEW-MS. That asymmetry is
  deliberate: it is deployed, pinned by golden vectors, and changing it is a
  separate decision — SKEW-MS remains that section's tolerance, not this one's."
  [e]
  (try
    (if-not (plain-object? e)
      nil
      ;; own-enumerable copy first, for the same reason the fold makes one:
      ;; `ts` and `state` both resolve up the prototype chain on an ordinary
      ;; object, so a bare read can invent a field the sender never sent. The
      ;; copy also materializes any getter once — a getter that throws costs
      ;; this one entry rather than the whole map.
      (let [own (js/Object.assign (js/Object.create nil) e)
            ts (oget own "ts")
            state (oget own "state")]
        (if-not (and (number? ts) (js/Number.isFinite ts) (pos? ts) (state-ok? state))
          nil
          (obj "state" state
               "ts" (js/Math.min ts (js/Date.now))))))
    (catch :default _ nil)))

(defn- entry-cost
  "How many code units this entry adds to the serialized map: `\"k\":<entry>`
  plus the comma (or the closing brace) that follows it. Summed with the
  opening brace, that is exactly `JSON.stringify(map).length`."
  [k e]
  (+ (.-length (js/JSON.stringify k)) 1 (.-length (js/JSON.stringify e)) 1))

(defn sanitize-apps-sync
  "Shape-check + clamp one untrusted apps section into a fresh object, or null.
  Never throws.

  Keys must match /^[a-z0-9-]{1,32}$/; an entry that does not shape-check is
  dropped and its neighbours are kept; nothing left is null, not an empty
  object, so the section is omitted rather than sent empty.

  Entries are inserted in sorted-key order, but that is NOT what the output
  order is: JS canonical property order hoists array-index-like keys ahead of
  the rest, numerically, and the key charset permits all-digit labels (\"2\"
  comes out before \"10\", and both before \"board\"). The guarantee is
  DETERMINISM — a given key set always serializes to the same bytes whichever
  device sanitized it — not lexicographic order.

  The whole-map cap is spent in that same order: an entry that would push the
  serialization past APPS-MAX is skipped and the smaller ones after it are
  still kept, which makes the result idempotent under a second pass. It cannot
  fire on a record id-kit wrote, which enforces the same cap on the way in."
  [m]
  (try
    (if-not (plain-object? m)
      nil
      (let [ks (.sort (js/Object.keys m))
            n (.-length ks)
            out (js-obj)]
        (loop [i 0 kept 0 used 1] ; 1 = the opening brace
          (if (>= i n)
            (if (zero? kept) nil out)
            (let [k (aget ks i)
                  e (when (.test app-key-re k) (sanitize-entry (oget m k)))
                  cost (when (some? e) (entry-cost k e))]
              (if (and (some? e) (<= (+ used cost) APPS-MAX))
                (do (unchecked-set out k e)
                    (recur (inc i) (inc kept) (+ used cost)))
                (recur (inc i) kept used)))))))
    (catch :default _ nil))) ; a Proxy, a throwing key trap — not a section

(defn- fold-entry
  "Which of two entries for the SAME key survives: strictly newer ts wins
  wholesale, and equal ts is broken by the greater canonical serialization —
  computed role-independently, so both devices pick the same one and converge
  in a single exchange.

  canon() throws on values it does not model (a bigint, a symbol, a
  function-valued key), which `sanitizeAppsSync` has already refused — so the
  guard below only fires for a caller that folded input the sanitizer never
  saw. Losing that one key's convergence beats throwing out of a public fold
  the hub calls unwrapped: the tiebreak degrades to keeping `local`, which is
  role-DEPENDENT, so such a pair converges no further than not crashing."
  [l r]
  (let [lts (oget l "ts")
        rts (oget r "ts")]
    (cond
      (> rts lts) r
      (> lts rts) l
      :else (try
              (if (pos? (compare (canon/canon r) (canon/canon l))) r l)
              (catch :default _ l)))))

(defn- own-copy
  "An own-enumerable, NULL-PROTOTYPE copy of one side of the fold, or an empty
  one if it is not a map (or throws on read).

  Null-prototype, because \"constructor\" matches the app-key charset: on an
  ordinary object `(oget l \"constructor\")` answers Object rather than
  undefined, and a key only the other side has would fold against the
  prototype. Own-enumerable copies make absence mean absence."
  [x]
  (try
    (js/Object.assign (js/Object.create nil) (if (plain-object? x) x (js-obj)))
    (catch :default _ (js/Object.create nil))))

(defn fold-apps-sync
  "Fold two devices' apps sections, PER KEY, over the union of both key sets.
  Never throws.

  A key only one side has is adopted as it stands, however old — an app the
  other device has never opened is not a deletion. A key both sides have is
  resolved by `fold-entry` alone, so no key can drag a sibling: the newest chat
  section and the newest board section both survive whichever device they came
  from. Commutative, idempotent, and order-stable.

  Order-stable, not sorted: keys are visited in sorted order, but JS canonical
  property order hoists array-index-like keys ahead of the rest, numerically,
  and the key charset permits all-digit labels. The guarantee is DETERMINISM —
  the same key set always comes out in the same order — not lexicographic
  order.

  Both sides are expected to have been through `sanitizeAppsSync` — this is the
  merge rule, not the shape check. Keys outside the app-key charset are dropped
  rather than trusted, so a `__proto__` own key (exactly what JSON.parse of
  wire text produces) can never reach the output's prototype setter."
  [local remote]
  (let [l (own-copy local)
        r (own-copy remote)
        ;; sorted union: duplicates land next to each other, so the previous
        ;; key is the whole dedup — and `out` is never read back
        ks (.sort (.concat (js/Object.keys l) (js/Object.keys r)))
        n (.-length ks)
        ;; the output is built null-prototype too — the charset filter below is
        ;; what makes a poisoned key unreachable, this is the net under it, and
        ;; it is why the final copy out to an ordinary object is safe to make
        ;; with [[Set]] semantics
        out (js/Object.create nil)]
    (loop [i 0]
      (if (>= i n)
        (js/Object.assign (js-obj) out)
        (let [k (aget ks i)]
          (when (and (.test app-key-re k)
                     (or (zero? i) (not (identical? k (aget ks (dec i))))))
            (let [lv (oget l k)
                  rv (oget r k)]
              (unchecked-set out k
                             (cond
                               (identical? lv js/undefined) rv
                               (identical? rv js/undefined) lv
                               :else (fold-entry lv rv)))))
          (recur (inc i)))))))