id-kit / src / ardegazu / id / bridge_host.cljs
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
;; ported-from: src/bridge-host.ts @ v1.1.0
;;
;; The bridge HOST — runs inside the tiny page at https://ardegazu.ro/id/,
;; embedded as a hidden same-site iframe by every suite app. It is storage,
;; not an oracle: it holds the one IdRecord on the apex origin and answers
;; get/put/profile/soc/clear with compare-and-set on the seed.
;;
;; Trust boundary: every inbound message passes the origin gate; replies go
;; back via `event.source.postMessage(reply, event.origin)` — a seed is never
;; posted with targetOrigin "*". Unsolicited state pushes (another app wrote,
;; observed via the `storage` event) go only to the client whose origin was
;; already proven by a valid request.
;;
;; The apex hub page itself does NOT use this over postMessage — it is the
;; apex origin, so it calls readBridgeRecord/writeBridgeRecord directly.
(ns ardegazu.id.bridge-host
  (:refer-clojure :exclude [object?])
  (:require [ardegazu.id.profile :as profile]
            [ardegazu.id.protocol :as protocol]))

(defn- object? [x]
  (and (some? x) (identical? "object" (js* "typeof ~{}" x))))

;; Hard cap on the serialized record (`soc` and `apps` are the open-ended fields).
;;
;; UNITS — one rule for every limit in this file, and for the suite: a size is
;; the number of UTF-16 CODE UNITS in the JSON serialization, i.e.
;; `(.-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), so the same value measured the other way can be twice this number —
;; which is exactly why the rule has to be shared: the sync layer that carries
;; these sections between a user's devices measures them the same way, and any
;; kit that disagreed would silently accept locally what the other end drops.
;; The suite-wide values, spelled out so drift is visible:
;;   MAX-RECORD-BYTES     131072 code units
;;   MAX-APP-STATE-BYTES   16384 code units
;;   RESERVED-CORE-BYTES   32768 code units
;;   MAX-APPS-BYTES        98304 code units
(def MAX-RECORD-BYTES (* 128 1024))

;; The suite's identity record lives in ONE localStorage entry on the apex
;; origin, and that quota is a fixed external constraint (~5 MiB per origin,
;; shared with everything else the hub stores) — so the record has to be
;; bounded. What is bounded here is DIRECTORY METADATA only: a section is a
;; little index an app publishes for the rest of the suite to act on (the house
;; rule against capping user *history* is untouched — history does not live
;; here, and must not be put here).
;;
;; Two apps at the old 64 KiB per-entry cap were enough to fill the whole
;; record and then permanently conflict every other writer — social-kit's `soc`
;; included — with no way to recover short of destroying the identity. So:
;;   * a section is capped well below the record (16 KiB — hundreds of entries)
;;   * the `apps` map as a WHOLE may not exceed MAX-APPS-BYTES, leaving
;;     RESERVED-CORE-BYTES of headroom that only the core fields (`soc`,
;;     profile) can spend. `soc`/`profile` writes keep the plain whole-record
;;     check, so that reserve is always theirs.
(def MAX-APP-STATE-BYTES 16384)
(def RESERVED-CORE-BYTES (* 32 1024))
(def MAX-APPS-BYTES (- MAX-RECORD-BYTES RESERVED-CORE-BYTES))

(defn- json-length
  "Serialized length of a value, or nil if it can't be JSON'd."
  [x]
  (try
    (let [s (js/JSON.stringify x)]
      (if (string? s) (.-length s) nil))
    (catch :default _ nil)))

(defn sanitize-apps
  "Validate untrusted `apps` data into a plain object of `{state, ts}` entries,
   or null. Never throws.

   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 APP-KEY-RE permits all-digit labels. The
   guarantee is DETERMINISM, not lexicographic order — sanitize re-runs on
   every write, so a given key set always serializes to the same bytes no
   matter which app wrote last."
  [x]
  (if-not (and (object? x) (not (js/Array.isArray x)))
    nil
    (let [out (js-obj)
          ;; an index loop, not `doseq`: seq-ing a JS array pulls cljs.core's
          ;; collection runtime through :advanced DCE, and this kit is compiled
          ;; from source into its consumers' bundles. Same order, same result.
          ks (.sort (js/Object.keys x))
          kn (.-length ks)
          kept (volatile! 0)]
      (loop [i 0]
        (when (< i kn)
          (let [k (aget ks i)
                e (unchecked-get x k)]
            (when (and (.test protocol/APP-KEY-RE k) (object? e))
              (let [ts (unchecked-get e "ts")
                    state (unchecked-get e "state")
                    n (json-length state)]
                (when (and (number? ts) (js/Number.isFinite ts) (> ts 0)
                           (some? n) (<= n MAX-APP-STATE-BYTES))
                  (vswap! kept inc)
                  (unchecked-set out k (js-obj "state" state "ts" ts))))))
          (recur (inc i))))
      (if (pos? @kept) out nil))))

(defn sanitize-record
  "Validate untrusted data into an IdRecord, or null. Never throws."
  [x]
  (if-not (object? x)
    nil
    (let [seed (unchecked-get x "seed")]
      (if-not (and (string? seed) (.test protocol/SEED-RE seed))
        nil
        (let [prof (profile/clamp-profile x)
              now (js/Date.now)
              num (fn [v] (if (and (number? v) (js/Number.isFinite v) (> v 0)) v now))
              soc (unchecked-get x "soc")
              ;; built by sequential assignment: the record is JSON.stringify'd
              ;; into apex storage, so insertion order IS the storage shape —
              ;; and cljs's js-obj scrambles literals past 8 keys (the record
              ;; is TEN fields)
              rec (js-obj)]
          (unchecked-set rec "v" 1)
          (unchecked-set rec "seed" seed)
          (unchecked-set rec "name" (unchecked-get prof "name"))
          (unchecked-set rec "hue" (unchecked-get prof "hue"))
          (unchecked-set rec "glyph" (unchecked-get prof "glyph"))
          (unchecked-set rec "lang" (unchecked-get prof "lang"))
          (unchecked-set rec "soc" (if (undefined? soc) nil soc))
          (unchecked-set rec "apps" (sanitize-apps (unchecked-get x "apps")))
          (unchecked-set rec "createdAt" (num (unchecked-get x "createdAt")))
          (unchecked-set rec "updatedAt" (num (unchecked-get x "updatedAt")))
          rec)))))

(defn- fits? [rec]
  (let [n (json-length rec)]
    (and (some? n) (<= n MAX-RECORD-BYTES))))

(defn read-bridge-record
  "Read the record straight from apex-origin storage (hub + host use)."
  []
  (try
    (let [raw (.getItem js/localStorage protocol/BRIDGE-STORE-KEY)]
      (js-obj "rec" (if raw (sanitize-record (js/JSON.parse raw)) nil)
              "ephemeral" false))
    (catch :default _
      (js-obj "rec" nil "ephemeral" true))))

(defn write-bridge-record
  "Write (or clear) the record on the apex origin. False = storage unavailable."
  [rec]
  (try
    (if (nil? rec)
      (.removeItem js/localStorage protocol/BRIDGE-STORE-KEY)
      (.setItem js/localStorage protocol/BRIDGE-STORE-KEY (js/JSON.stringify rec)))
    true
    (catch :default _ false)))

(defn init-bridge-host []
  ;; In-memory fallback so private-mode sessions still work for their lifetime.
  ;; Volatiles, not atoms: nothing here watches or CAS-swaps these cells, and
  ;; cljs.core's Atom drags the whole watch/collection runtime into a consumer
  ;; that compiles this namespace from source (bridge-client already does this).
  (let [mem-rec (volatile! nil)
        ephemeral (volatile! false)
        ;; The one proven client (an iframe has one embedder). Set only after a
        ;; valid, origin-gated request — unsolicited pushes need a proven origin.
        client (volatile! nil)

        load (fn []
               (if @ephemeral
                 @mem-rec
                 (let [r (read-bridge-record)]
                   (if (unchecked-get r "ephemeral")
                     (do (vreset! ephemeral true) @mem-rec)
                     (unchecked-get r "rec")))))

        store (fn [rec]
                (vreset! mem-rec rec)
                (when (and (not @ephemeral) (not (write-bridge-record rec)))
                  (vreset! ephemeral true))
                js/undefined)

        state-reply (fn [req-id]
                      (let [rec (load)
                            msg (js-obj "t" "state" "v" 1 "rec" rec)]
                        (when-not (undefined? req-id)
                          (unchecked-set msg "reqId" req-id))
                        (when @ephemeral
                          (unchecked-set msg "ephemeral" true))
                        msg))]

    (.addEventListener
     js/window "message"
     (fn [^js ev]
       (when (and (protocol/is-allowed-app-origin (.-origin ev))
                  (.-source ev)
                  (protocol/is-bridge-request (.-data ev)))
         (let [msg (.-data ev)
               ;; the origin the gate just proved — the ONLY thing an app's
               ;; `apps` key may be derived from
               origin (.-origin ev)]
           (vreset! client (js-obj "source" (.-source ev) "origin" origin))
           (let [reply (fn [r]
                         (let [c @client]
                           (.postMessage ^js (unchecked-get c "source") r
                                         (unchecked-get c "origin"))))
                 cur (load)
                 cur-seed (if (some? cur) (unchecked-get cur "seed") nil)
                 ;; `reason` is ADDITIVE: old clients ignore the extra field,
                 ;; new ones can tell a lost CAS from a size refusal (which no
                 ;; amount of retrying will fix).
                 conflict (fn
                            ([] (reply (js-obj "t" "conflict" "v" 1
                                               "reqId" (unchecked-get msg "reqId")
                                               "rec" cur)))
                            ([reason]
                             (reply (js-obj "t" "conflict" "v" 1
                                            "reqId" (unchecked-get msg "reqId")
                                            "rec" cur
                                            "reason" reason))))
                 t (unchecked-get msg "t")]
             (cond
               (identical? t "get")
               (reply (state-reply (unchecked-get msg "reqId")))

               (identical? t "put")
               (let [rec (sanitize-record (unchecked-get msg "rec"))]
                 (if (or (nil? rec)
                         (not (identical? cur-seed (unchecked-get msg "expect"))))
                   (conflict)
                   (let [now (js/Date.now)
                         next (js/Object.assign (js-obj) rec)
                         same-seed? (and (some? cur)
                                         (identical? (unchecked-get cur "seed")
                                                     (unchecked-get rec "seed")))]
                     ;; an unchanged seed keeps its birthday; a new seed starts fresh
                     (unchecked-set next "createdAt"
                                    (if same-seed?
                                      (unchecked-get cur "createdAt")
                                      (unchecked-get rec "createdAt")))
                     ;; THE RULE FOR `apps`: it NEVER comes off the wire. Only the
                     ;; `app` arm writes a section, and only the one its PROVEN
                     ;; origin names. A put is a profile write from any allowed
                     ;; origin, so honoring rec.apps would be a second door onto
                     ;; every other app's section (with a forgeable `ts` on top),
                     ;; and pre-`apps` clients send nine-field records that would
                     ;; wipe the whole directory. So the stored map carries over
                     ;; verbatim, and a put that CHANGES the seed is a different
                     ;; identity — it starts sectionless.
                     ;; (`soc` deliberately keeps its original behavior — the
                     ;; put's value wins — since one kit owns it and always
                     ;; round-trips the whole blob.)
                     (unchecked-set next "apps"
                                    (if same-seed? (unchecked-get cur "apps") nil))
                     (unchecked-set next "updatedAt" now)
                     ;; the cap belongs on what actually gets STORED: `next`
                     ;; carries the grafted-on sections, `rec` does not
                     (if-not (fits? next)
                       (conflict)
                       (do (store next)
                           (reply (state-reply (unchecked-get msg "reqId"))))))))

               (identical? t "profile")
               (if (or (nil? cur) (not (identical? cur-seed (unchecked-get msg "expect"))))
                 (conflict)
                 (let [patch (let [p (unchecked-get msg "patch")]
                               (if (object? p) p (js-obj)))
                       merged (profile/clamp-profile
                               (js-obj "name" (if (js-in "name" patch)
                                                (unchecked-get patch "name")
                                                (unchecked-get cur "name"))
                                       "hue" (if (js-in "hue" patch)
                                               (unchecked-get patch "hue")
                                               (unchecked-get cur "hue"))
                                       "glyph" (if (js-in "glyph" patch)
                                                 (unchecked-get patch "glyph")
                                                 (unchecked-get cur "glyph"))
                                       "lang" (if (js-in "lang" patch)
                                                (unchecked-get patch "lang")
                                                (unchecked-get cur "lang"))))
                       next (js/Object.assign (js-obj) cur merged)]
                   (unchecked-set next "updatedAt" (js/Date.now))
                   (store next)
                   (reply (state-reply (unchecked-get msg "reqId")))))

               (identical? t "soc")
               (if (or (nil? cur) (not (identical? cur-seed (unchecked-get msg "expect"))))
                 (conflict)
                 (let [soc (unchecked-get msg "soc")
                       next (js/Object.assign (js-obj) cur)]
                   (unchecked-set next "soc" (if (undefined? soc) nil soc))
                   (unchecked-set next "updatedAt" (js/Date.now))
                   (if-not (fits? next)
                     (conflict)
                     (do (store next)
                         (reply (state-reply (unchecked-get msg "reqId")))))))

               ;; One section per app, keyed by the PROVEN origin: every app
               ;; reads the whole map, none can write another's entry. The
               ;; host stamps `ts` — a client cannot forge freshness.
               (identical? t "app")
               (let [k (protocol/app-key-of-origin origin)
                     state (unchecked-get msg "state")
                     drop? (or (nil? state) (undefined? state))
                     n (if drop? 0 (json-length state))]
                 (cond
                   ;; no record, or the CAS lost the race — retrying may help
                   (or (nil? cur)
                       (not (identical? cur-seed (unchecked-get msg "expect"))))
                   (conflict "cas")

                   ;; allowed to talk to the bridge, but no key derives from
                   ;; this origin (over-long label, reserved label) — permanent
                   (nil? k)
                   (conflict "key")

                   ;; unserializable or over the per-section cap — permanent
                   ;; until the caller sends something smaller
                   (or (nil? n) (> n MAX-APP-STATE-BYTES))
                   (conflict "size")

                   :else
                   (let [cur-apps (unchecked-get cur "apps")
                         apps (js/Object.assign (js-obj) cur-apps)]
                     (if drop?
                       (js-delete apps k)
                       (unchecked-set apps k (js-obj "state" state "ts" (js/Date.now))))
                     (let [next-apps (sanitize-apps apps)
                           apps-n (json-length next-apps)
                           next (js/Object.assign (js-obj) cur)]
                       (unchecked-set next "apps" next-apps)
                       (unchecked-set next "updatedAt" (js/Date.now))
                       ;; the sections' collective budget stops short of the
                       ;; record's, so `soc` and the profile always have room
                       (if (or (nil? apps-n)
                               (> apps-n MAX-APPS-BYTES)
                               (not (fits? next)))
                         (conflict "full")
                         (do (store next)
                             (reply (state-reply (unchecked-get msg "reqId")))))))))

               (identical? t "clear")
               (if-not (identical? cur-seed (unchecked-get msg "expect"))
                 (conflict)
                 (do (store nil)
                     (reply (state-reply (unchecked-get msg "reqId")))))))))))

    ;; Another app's iframe (or the hub page) wrote the key → push fresh state
    ;; to our proven client so open tabs converge live.
    (.addEventListener
     js/window "storage"
     (fn [^js ev]
       (when-not (and (some? (.-key ev))
                      (not (identical? (.-key ev) protocol/BRIDGE-STORE-KEY)))
         (when-some [c @client]
           (.postMessage ^js (unchecked-get c "source") (state-reply js/undefined)
                         (unchecked-get c "origin"))))))

    ;; Announce readiness to the embedder. Carries no payload, so "*" is fine —
    ;; the embedder filters by the bridge origin on its side.
    (when (and (.-parent js/window) (not (identical? (.-parent js/window) js/window)))
      (.postMessage (.-parent js/window) (js-obj "t" "id-ready" "v" 1) "*"))
    js/undefined))

static mirror of HEAD · about · clone: git clone https://git.ardegazu.ro/id-kit.git