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
363
364
365
366
367 | ;; ported-from: src/board/index.ts @ v1.0.0
;;
;; Headless board client (link-mode boards). The board is a fork of the sueta
;; stack — same Net, same RoomLog, same /sueta/2/ protocol strings — separated
;; only by APP_SALT. Elements fold from add/edit/del log ops; a drawn stroke is a
;; throttled live {kind:"draw"} preview followed by one committed "add" with
;; delta-encoded fixed-point points (world × 100), exactly what the pen tool
;; produces.
;;
;; Strict-mode boards (sealed ops under epoch keys) are out of scope for v1 — the
;; client reads and draws on link boards, the default.
(ns ardegazu.rooms.board
(:require ["node:events" :refer (EventEmitter)]
["node:path" :as path]
["@libp2p/crypto/keys" :refer (generateKeyPair)]
["@libp2p/peer-id" :refer (peerIdFromPrivateKey)]
[ardegazu.rooms.js :as j]
[ardegazu.rooms.lib.crypto :as rc]
[ardegazu.rooms.lib.descriptor :as descriptor]
[ardegazu.rooms.lib.log :as rlog]
[ardegazu.rooms.lib.net :as net]
[ardegazu.rooms.lib.turn :as turn]
[ardegazu.rooms.node.env :as env]
[ardegazu.rooms.node.stores :as stores]
[shadow.cljs.modern :refer (defclass js-await)]))
(def new-room-secret rc/new-room-secret)
(def BOARD-SALT "board.ardegazu.ro/v1")
(def ^:private DRAW-BCAST-MS 50) ; ~20 Hz live stroke segments, like the pen tool
(def ^:private DEFAULTS
(j/ordered
"relayMultiaddr" "/dns4/signal.ardegazu.ro/tcp/443/tls/ws/p2p/12D3KooWQzZvygPwd2F4JAqqf6tfBSJ29YtjzzftUyJ37RLCG5WT"
"turnCredsUrl" "https://signal.ardegazu.ro/turn-credentials"
"discoveryTopic" "_peer-discovery._p2p._pubsub"))
;; StrokeSpec — {id, k:"stroke", x, y, pts, prs?, w, c}, where `pts` is a flat
;; [dx0,dy0,…] of fixed-point ints (world*100) delta-encoded from (x,y).
;; BoardElement — any {id, k, …} record the board's ops carry.
;; NAMING HAZARD: node:events' EventEmitter keeps its own bookkeeping in the
;; instance fields `_events`, `_eventsCount` and `_maxListeners`. Every private
;; field below is `_`-prefixed by the port's convention, so never add one called
;; `_events` here — it would silently destroy the emitter. (lib/net's Net does
;; use `_events` for its NetEvents object, and deliberately does NOT extend
;; EventEmitter.)
(defclass BoardClient
(extends EventEmitter)
(constructor [this net-obj log room-id name]
(super)
(unchecked-set this "net" net-obj)
(unchecked-set this "log" log)
(unchecked-set this "roomId" room-id)
(unchecked-set this "_name" name)
(unchecked-set this "_elements" (js/Map.))
;; Fold bookkeeping lives in SIDE maps, never on the element objects:
;; `elements()` hands those objects straight to consumers (the RL gym reads
;; them), so an `addClock` field on them would be a silent API change. The
;; browser (board/client/src/board/app/state.cljs) can afford to keep the
;; same data on a record that WRAPS the spec; we cannot.
;; _addMeta : element id -> {clock, hash} of the winning add
;; _editSeen : "<element id>|<field>" -> {clock, hash} of the winning edit
(unchecked-set this "_addMeta" (js/Map.))
(unchecked-set this "_editSeen" (js/Map.))
(unchecked-set this "_deleted" (js/Set.)))) ; tombstones are terminal
(declare apply-entry)
(defn- sleep [ms]
(js/Promise. (fn [r] (js/setTimeout r ms))))
(defn- encode-pts
"Delta-encode absolute world points, verbatim from the app's ops.ts."
[points]
(if (< (.-length ^js points) 2)
(j/ordered "x" 0 "y" 0 "pts" (array))
(let [x (aget points 0)
y (aget points 1)
pts (array)]
(loop [i 2 px (js/Math.round (* x 100)) py (js/Math.round (* y 100))]
(when (< (+ i 1) (.-length ^js points))
(let [qx (js/Math.round (* (aget points i) 100))
qy (js/Math.round (* (aget points (+ i 1)) 100))]
(.push pts (- qx px))
(.push pts (- qy py))
(recur (+ i 2) qx qy))))
(j/ordered "x" x "y" y "pts" pts))))
(defn elements [self]
(let [out (array)]
(.forEach ^js (unchecked-get self "_elements") (fn [el _k] (.push out el)))
out))
(defn draw-stroke
"Draw a stroke: stream live preview segments at the pen cadence, then commit
the add op. `points` are absolute world coordinates."
[self points style]
(-> (js/Promise.resolve nil)
(.then
(fn [_]
(when (< (.-length ^js points) 2)
(throw (js/Error. "a stroke needs at least 2 points")))
(let [st (if (j/truthy? style) style (j/ordered))
id (rc/to-b64url (rc/random-bytes 16))
w (j/nn (unchecked-get st "width") 2)
c (js/Math.min (js/Math.max (j/nn (unchecked-get st "color") 0) 0) 7)
flat (array)]
(.forEach ^js points (fn [p]
(.push flat (unchecked-get p "x"))
(.push flat (unchecked-get p "y"))))
;; live preview: ≤512 numbers per segment at ~20 Hz, then done
(letfn [(step [i]
(if (>= i (.-length flat))
(js/Promise.resolve nil)
(let [seg (.slice flat i (+ i 512))
done (>= (+ i 512) (.-length flat))
payload (j/ordered "kind" "draw" "id" id "seg" seg "w" w "c" c)]
(when done (unchecked-set payload "done" true))
(js-await [_ (net/broadcast (unchecked-get self "net") payload)]
(if done
nil
(js-await [_ (sleep DRAW-BCAST-MS)]
(step (+ i 512))))))))]
(js-await [_ (step 0)]
(let [enc (encode-pts flat)
;; {id, k, ...encodePts(flat), w, c} — seven keys, in the
;; pen tool's order (test/vectors/protocol.json)
el (j/ordered "id" id "k" "stroke"
"x" (unchecked-get enc "x")
"y" (unchecked-get enc "y")
"pts" (unchecked-get enc "pts")
"w" w "c" c)]
(js-await [_ (rlog/append (unchecked-get self "log")
(j/ordered "t" "add" "ts" (js/Date.now)
"name" (unchecked-get self "_name")
"el" el))]
(do (.set ^js (unchecked-get self "_elements") id el)
id))))))))))
(defn add-text [self x y text opts]
(let [o (if (j/truthy? opts) opts (j/ordered))
id (rc/to-b64url (rc/random-bytes 16))
el (j/ordered "id" id "k" "text" "x" x "y" y "text" text
"size" (j/nn (unchecked-get o "size") 16)
"c" (js/Math.min (js/Math.max (j/nn (unchecked-get o "color") 0) 0) 7))]
(js-await [_ (rlog/append (unchecked-get self "log")
(j/ordered "t" "add" "ts" (js/Date.now)
"name" (unchecked-get self "_name")
"el" el))]
(do (.set ^js (unchecked-get self "_elements") id el)
id))))
(defn erase [self ids]
(js-await [_ (rlog/append (unchecked-get self "log")
(j/ordered "t" "del" "ts" (js/Date.now)
"name" (unchecked-get self "_name")
"ids" ids))]
(do
(.forEach ^js ids (fn [id]
(.add ^js (unchecked-get self "_deleted") id)
(.delete ^js (unchecked-get self "_elements") id)
(.delete ^js (unchecked-get self "_addMeta") id)))
js/undefined)))
(defn close [self]
(js-await [_ (rlog/close (unchecked-get self "log"))]
(js-await [_ (net/close (unchecked-get self "net"))]
js/undefined)))
;; ---- fold policy -----------------------------------------------------------
;;
;; Log entries arrive in REPLICATION order, which differs per peer, so the fold
;; has to be a function of the entry set alone. The suite's total order is
;; (clock ascending, then hash ascending) — `clock` numeric, `hash` compared as
;; a JS string (CLJS's two-arg `<`/`>` inline to the raw JS operators, so these
;; ARE string comparisons; that is deliberate, not a coercion bug).
;;
;; Both rules below are ported field-for-field from the deployed browser
;; (board/client/src/board/app/state.cljs, `apply-add` / `apply-edit`): the
;; browser is the contract, and a headless reader that folds differently makes a
;; bot's `elements()` disagree with every canvas on a busy board.
(defn- add-superseded?
"Rule 1 — duplicate `add` for a known element id: the EARLIEST (clock, hash)
wins, so the record already held supersedes the incoming one when
existing.clock < incoming.clock
OR (existing.clock == incoming.clock AND existing.hash <= incoming.hash)
The `<=` is load-bearing: on a genuinely identical (clock, hash) the existing
record is kept, which is what makes re-ingesting the same entry idempotent."
[prev ec eh]
(let [xc (unchecked-get prev "clock")
xh (unchecked-get prev "hash")]
(or (< xc ec)
(and (identical? xc ec) (js* "~{} <= ~{}" xh eh)))))
(defn- edit-field-stale?
"Rule 2 — racing `edit`s fold per (element id, field), not per patch, so
\"A moves it while B recolours it\" converges to both effects everywhere.
The field is SKIPPED when the (clock, hash) already recorded for it is later:
prev.clock > e.clock
OR (prev.clock == e.clock AND prev.hash > e.hash)"
[prev ec eh]
(let [pc (unchecked-get prev "clock")
ph (unchecked-get prev "hash")]
(or (> pc ec)
(and (identical? pc ec) (js* "~{} > ~{}" ph eh)))))
(defn- apply-entry [self e]
(let [op (unchecked-get e "op")
t (unchecked-get op "t")
ec (unchecked-get e "clock")
eh (unchecked-get e "hash")]
(cond
(identical? "add" t)
(let [el (unchecked-get op "el")]
(when-not (or (not (j/truthy? el))
(not (identical? "string" (js* "typeof ~{}" (unchecked-get el "id"))))
(.has ^js (unchecked-get self "_deleted") (unchecked-get el "id")))
(let [id (unchecked-get el "id")
existing (.get ^js (unchecked-get self "_elements") id)
am ^js (unchecked-get self "_addMeta")
prev (.get am id)]
;; A locally-authored element (drawStroke/addText) sits in _elements
;; with no meta until the log echoes its own add back — no meta means
;; nothing to compare, so the add applies, exactly as it did before.
(when-not (and (j/truthy? existing)
(j/truthy? prev)
(add-superseded? prev ec eh))
(.set am id (j/ordered "clock" ec "hash" eh))
(.set ^js (unchecked-get self "_elements") id el)
(.emit ^js self "element" el (unchecked-get e "from"))))))
(identical? "edit" t)
(let [id (unchecked-get op "id")
el (.get ^js (unchecked-get self "_elements") id)
p (unchecked-get op "p")]
(when (and (not (identical? el js/undefined))
(j/truthy? el)
(j/truthy? p)
(j/js-object? p))
(let [seen ^js (unchecked-get self "_editSeen")
changed (volatile! false)]
;; per-field fold, in the patch's own key order — the same order
;; `Object.assign` walked, so an element's key insertion order (and
;; therefore its JSON bytes) is unchanged for a non-racing patch
(.forEach (js/Object.keys p)
(fn [field]
(let [k (str id "|" field)
prev (.get seen k)]
(when-not (and (j/truthy? prev) (edit-field-stale? prev ec eh))
(.set seen k (j/ordered "clock" ec "hash" eh))
(unchecked-set el field (unchecked-get p field))
(vreset! changed true)))
js/undefined))
;; a patch every field of which lost the fold changes nothing, so it
;; emits nothing (the browser gates its onChange the same way)
(when @changed (.emit ^js self "edited" id p)))))
(identical? "del" t)
(let [ids (j/nn (unchecked-get op "ids") (array))]
(.forEach ^js ids (fn [id]
(.add ^js (unchecked-get self "_deleted") id)
(.delete ^js (unchecked-get self "_elements") id)
;; the add meta dies with the element it described,
;; as it does in the browser (the record goes). The
;; tombstone is terminal, so this is unreachable
;; state either way — it just does not accumulate.
(.delete ^js (unchecked-get self "_addMeta") id)))
(.emit ^js self "deleted" ids))
:else nil))
js/undefined)
;; ---- join ------------------------------------------------------------------
(defn join [opts]
(-> (js/Promise.resolve nil)
(.then
(fn [_]
(let [origin (j/nn (unchecked-get opts "origin") "https://board.ardegazu.ro")
data-dir (unchecked-get opts "dataDir")
salt (j/nn (unchecked-get opts "appSalt") BOARD-SALT)
identity (j/nn (unchecked-get opts "identity") nil)]
(env/install-origin origin)
(env/install-browser-globals (path/join data-dir "kv.json"))
(js-await [private-key (generateKeyPair "Ed25519")]
(let [peer-id (.toString (peerIdFromPrivateKey private-key))]
(js-await [room-crypto (rc/create (unchecked-get opts "roomSecret") salt peer-id)]
(js-await [resolved (descriptor/resolve-relay-config
(js/Object.assign (js-obj) DEFAULTS (unchecked-get opts "relay")))]
(let [cfg (js/Object.assign (js-obj) resolved (unchecked-get opts "relay"))
ice (turn/IceConfig. (unchecked-get cfg "turnCredsUrl") false)
cell (array nil)
client-of (fn [] (aget cell 0))]
(js-await [net-obj
(net/create
(j/ordered
"privateKey" private-key
"crypto" room-crypto
"ice" ice
"wsOrigin" origin
"relayMultiaddr" (unchecked-get cfg "relayMultiaddr")
"discoveryTopic" (unchecked-get cfg "discoveryTopic")
"myName" (fn []
(let [c (client-of)]
(if (j/truthy? c)
(unchecked-get c "_name")
(unchecked-get opts "name"))))
"events"
(j/ordered
"peerState" (fn [peer _state name]
(let [c (client-of)]
(when (j/truthy? c) (.emit ^js c "peer" peer name)))
js/undefined)
"peerGone" (fn [peer]
(let [c (client-of)]
(when (j/truthy? c) (.emit ^js c "peerGone" peer)))
js/undefined)
;; live cur/draw/drag previews — a headless
;; reader skips them
"message" (fn [_from _payload] js/undefined)
"binary" (fn [_from _data] js/undefined)
"peerReady" (fn [_peer] js/undefined)
"status" (fn [up]
(let [c (client-of)]
(when (j/truthy? c) (.emit ^js c "status" up)))
js/undefined))))]
(js-await [helia (stores/open-fs-helia
(unchecked-get net-obj "libp2p")
(j/ordered "blocks" (path/join data-dir "blocks")
"data" (path/join data-dir "data")))]
(let [pending (array)]
(js-await [log (rlog/open
helia room-crypto identity
(j/ordered
"onEntry" (fn [e]
(let [c (client-of)]
(if (j/truthy? c)
(apply-entry c e)
(.push pending e)))
js/undefined)
"onError" (fn [_] js/undefined)
"directory" (path/join data-dir "orbitdb")))]
(let [client (BoardClient. net-obj log (unchecked-get room-crypto "roomId")
(unchecked-get opts "name"))]
(aset cell 0 client)
(doseq [e (array-seq (.splice pending 0))] (apply-entry client e))
(js-await [_ (rlog/load-tail log 2000)]
(do (.emit ^js client "ready")
client)))))))))))))))))
;; ---- class surface ---------------------------------------------------------
(unchecked-set BoardClient "join" (fn [opts] (join opts)))
(let [proto (.-prototype BoardClient)]
(unchecked-set proto "elements" (fn [] (this-as self (elements self))))
(unchecked-set proto "drawStroke" (fn [points style] (this-as self (draw-stroke self points style))))
(unchecked-set proto "addText" (fn [x y text opts] (this-as self (add-text self x y text opts))))
(unchecked-set proto "erase" (fn [ids] (this-as self (erase self ids))))
(unchecked-set proto "close" (fn [] (this-as self (close self))))
;; the "private" surface the tests drive (peer-kit's `_name` idiom)
(unchecked-set proto "_applyEntry" (fn [e] (this-as self (apply-entry self e)))))
|