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/chat/index.ts @ v1.0.0
;;
;; Headless sueta chat client: the same boot sequence as the app's room.ts —
;; session key → room crypto → libp2p Net → Helia → OrbitDB log — minus the UI,
;; calls and mailbox. History IS replication: messages fold from the encrypted log
;; identically on every member; live hello/name/presence ride the sealed channels.
;;
;; VENDOR RETIREMENT: `verifyAssertion` comes from the real id-kit — now as the
;; defining namespace `ardegazu.id.identity` off the classpath (deps.edn), not
;; as an ESM import of its compiled dist, and never from a hand-maintained copy
;; under src/vendor/id/.
(ns ardegazu.rooms.chat
(:require ["node:events" :refer (EventEmitter)]
["node:path" :as path]
["@libp2p/crypto/keys" :refer (generateKeyPair)]
["@libp2p/peer-id" :refer (peerIdFromPrivateKey)]
[ardegazu.id.identity :as id]
[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 CHAT-SALT "chat.ardegazu.ro/v2")
(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"))
;; ChatMessage — {id, from, name, ts, text?, img?, thread?, reactions}
;; id log entry hash
;; from durable author id (b64url Ed25519 pub) or ""
;; reactions Map<emoji, Set<authorId>>
;; ChatPeer — {state, name?, ident?: {pub, fp}}
;; An RxOp (the reaction fold's per-key state) is {clock, hash, op}.
;; 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 ChatClient
(extends EventEmitter)
(constructor [this net-obj log room-id name identity salt]
(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 "_identity" identity)
(unchecked-set this "_salt" salt)
(unchecked-set this "_messages" (js/Map.))
(unchecked-set this "_rx" (js/Map.)) ; author|target|emoji → newest op
(unchecked-set this "_peers" (js/Map.))))
(declare apply-entry apply-reaction fold-reactions-into on-live on-peer-state
id-fields send-hello)
(defn peers [self]
(unchecked-get self "_peers"))
(defn history [self]
(let [out (array)]
(.forEach ^js (unchecked-get self "_messages") (fn [m _k] (.push out m)))
(.sort out (fn [a b]
;; TS `a.ts - b.ts || (a.id < b.id ? -1 : 1)` — the `||` is JS
;; truthiness, so both +0 and -0 fall through to the tiebreak
(let [d (- (unchecked-get a "ts") (unchecked-get b "ts"))]
(if (j/truthy? d)
d
(if (< (unchecked-get a "id") (unchecked-get b "id")) -1 1)))))
out))
(defn send
"Append a chat op. Key order is the wire order (test/vectors/protocol.json)."
[self text thread]
(let [op (j/ordered "t" "chat" "ts" (js/Date.now) "name" (unchecked-get self "_name") "text" text)]
(when (j/truthy? thread) (unchecked-set op "thread" thread))
(rlog/append (unchecked-get self "log") op)))
(defn react [self target emoji op]
(rlog/append (unchecked-get self "log")
(j/ordered "t" "react" "ts" (js/Date.now) "name" (unchecked-get self "_name")
"target" target "emoji" emoji
"op" (if (identical? op js/undefined) "add" op))))
(defn set-name [self name]
(unchecked-set self "_name" name)
(js-await [fields (id-fields self)]
;; {kind, name, ...idFields} — the spread lands AFTER name, so idPub/idSig
;; are the last two keys on the wire (test/vectors/protocol.json)
(let [payload (j/ordered "kind" "name" "name" name)]
(doseq [k (array-seq (js/Object.keys fields))]
(unchecked-set payload k (unchecked-get fields k)))
(js-await [_ (net/broadcast (unchecked-get self "net") payload)]
js/undefined))))
(defn close [self]
(js-await [_ (rlog/close (unchecked-get self "log"))]
(js-await [_ (net/close (unchecked-get self "net"))]
js/undefined)))
(defn- id-fields [self]
(let [identity (unchecked-get self "_identity")]
(if-not (j/truthy? identity)
(js/Promise.resolve (j/ordered))
(js-await [sig (.assert ^js identity (unchecked-get self "_salt")
(unchecked-get self "roomId")
(net/my-id (unchecked-get self "net")))]
(j/ordered "idPub" (unchecked-get identity "publicKeyB64") "idSig" sig)))))
(defn- send-hello [self peer]
(js-await [fields (id-fields self)]
(let [payload (j/ordered "kind" "hello" "name" (unchecked-get self "_name"))]
(doseq [k (array-seq (js/Object.keys fields))]
(unchecked-set payload k (unchecked-get fields k)))
(js-await [_ (.catch (js/Promise.resolve (net/send-to (unchecked-get self "net") peer payload))
(fn [_] nil))]
js/undefined))))
(defn- on-peer-state [self peer state name]
(let [peers ^js (unchecked-get self "_peers")
existing (.get peers peer)
p (if (identical? existing js/undefined) (j/ordered "state" state) existing)]
(unchecked-set p "state" state)
(when (j/truthy? name) (unchecked-set p "name" name))
(.set peers peer p)
(.emit ^js self "peer" peer p))
js/undefined)
(defn- on-live [self from payload]
(let [p payload
kind (when (j/truthy? p) (unchecked-get p "kind"))]
(when (and (j/truthy? p)
(or (identical? "hello" kind) (identical? "name" kind)))
(let [peers ^js (unchecked-get self "_peers")
existing (.get peers from)
rec (if (identical? existing js/undefined) (j/ordered "state" "connecting") existing)
pname (unchecked-get p "name")
id-pub (unchecked-get p "idPub")
id-sig (unchecked-get p "idSig")]
(when (identical? "string" (js* "typeof ~{}" pname))
(unchecked-set rec "name" (.slice pname 0 40)))
(.set peers from rec)
(when (and (identical? "string" (js* "typeof ~{}" id-pub))
(identical? "string" (js* "typeof ~{}" id-sig)))
(.then (id/verify-assertion (unchecked-get self "_salt") (unchecked-get self "roomId")
from id-pub id-sig)
(fn [fp]
(when (j/truthy? fp) ; forged binding — identity-less peer
(unchecked-set rec "ident" (j/ordered "pub" id-pub "fp" fp))
(.emit ^js self "peer" from rec))
js/undefined)))
(.emit ^js self "peer" from rec))))
js/undefined)
;; `_self` — every helper in this family takes the ChatClient receiver first and
;; the call sites pass it; this one reads nothing off it. Kept in place rather
;; than dropped so the family keeps one shape.
(defn- apply-reaction [_self m emoji author op]
(when (j/truthy? author)
(let [reactions ^js (unchecked-get m "reactions")
by (.get reactions emoji)]
(if (identical? "add" op)
(let [set (if (identical? by js/undefined)
(let [s (js/Set.)] (.set reactions emoji s) s)
by)]
(.add set author))
(when-not (identical? by js/undefined)
(.delete by author)
(when (identical? 0 (.-size by)) (.delete reactions emoji))))))
js/undefined)
(defn- fold-reactions-into [self m]
(.forEach ^js (unchecked-get self "_rx")
(fn [rx key]
(let [parts (.split key "|")
author (aget parts 0)
target (aget parts 1)
emoji (aget parts 2)]
(when (identical? target (unchecked-get m "id"))
(apply-reaction self m emoji author (unchecked-get rx "op"))))))
js/undefined)
(defn- apply-entry [self e]
(let [op (unchecked-get e "op")
t (unchecked-get op "t")]
(cond
(identical? "chat" t)
(let [m (j/ordered "id" (unchecked-get e "hash")
"from" (unchecked-get e "from")
"name" (unchecked-get op "name")
"ts" (unchecked-get op "ts")
"text" (unchecked-get op "text"))]
(when (j/truthy? (unchecked-get op "thread"))
(unchecked-set m "thread" (unchecked-get op "thread")))
(unchecked-set m "reactions" (js/Map.))
(.set ^js (unchecked-get self "_messages") (unchecked-get e "hash") m)
(fold-reactions-into self m)
(.emit ^js self "message" m))
(identical? "img" t)
(let [m (j/ordered "id" (unchecked-get e "hash")
"from" (unchecked-get e "from")
"name" (unchecked-get op "name")
"ts" (unchecked-get op "ts")
"img" (j/ordered "cid" (unchecked-get op "cid")
"mime" (unchecked-get op "mime")
"bytes" (unchecked-get op "bytes")
"w" (unchecked-get op "w")
"h" (unchecked-get op "h")))]
(when (j/truthy? (unchecked-get op "thread"))
(unchecked-set m "thread" (unchecked-get op "thread")))
(unchecked-set m "reactions" (js/Map.))
(.set ^js (unchecked-get self "_messages") (unchecked-get e "hash") m)
(.emit ^js self "message" m))
(identical? "react" t)
;; fold per (author, target, emoji) by Lamport clock with hash tiebreak
(let [key (str (unchecked-get e "from") "|" (unchecked-get op "target") "|" (unchecked-get op "emoji"))
rx ^js (unchecked-get self "_rx")
cur (.get rx key)]
(when-not (and (not (identical? cur js/undefined))
(j/truthy? cur)
(or (> (unchecked-get cur "clock") (unchecked-get e "clock"))
(and (identical? (unchecked-get cur "clock") (unchecked-get e "clock"))
(> (unchecked-get cur "hash") (unchecked-get e "hash")))))
(.set rx key (j/ordered "clock" (unchecked-get e "clock")
"hash" (unchecked-get e "hash")
"op" (unchecked-get op "op")))
(let [target (.get ^js (unchecked-get self "_messages") (unchecked-get op "target"))]
(when-not (identical? target js/undefined)
(apply-reaction self target (unchecked-get op "emoji")
(unchecked-get e "from") (unchecked-get op "op"))
(.emit ^js self "reaction" (unchecked-get op "target") (unchecked-get op "emoji")
(unchecked-get e "from") (unchecked-get op "op"))))))
:else nil))
js/undefined)
;; ---- join ------------------------------------------------------------------
(defn join [opts]
(-> (js/Promise.resolve nil)
(.then
(fn [_]
;; every `??` below is NULLISH in the original, not falsy
(let [origin (j/nn (unchecked-get opts "origin") "https://chat.ardegazu.ro")
data-dir (unchecked-get opts "dataDir")
salt (j/nn (unchecked-get opts "appSalt") CHAT-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)
;; the client is created after Net (Net's callbacks need
;; it), so the callbacks read it out of a one-slot cell —
;; TS used a `let client!: ChatClient` closure variable
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) (on-peer-state c peer state name)))
js/undefined)
"peerGone" (fn [peer]
(let [c (client-of)]
(when (j/truthy? c)
(.delete ^js (unchecked-get c "_peers") peer)
(.emit ^js c "peerGone" peer)))
js/undefined)
"message" (fn [from payload]
(let [c (client-of)]
(when (j/truthy? c) (on-live c from payload)))
js/undefined)
"binary" (fn [_from _data] js/undefined)
"peerReady" (fn [peer]
(let [c (client-of)]
(when (j/truthy? c) (send-hello c 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)
;; undecryptable garbage from
;; non-members — expected noise
"onError" (fn [_] js/undefined)
"directory" (path/join data-dir "orbitdb")))]
(let [client (ChatClient. net-obj log (unchecked-get room-crypto "roomId")
(unchecked-get opts "name") identity salt)]
(aset cell 0 client)
(doseq [e (array-seq (.splice pending 0))] (apply-entry client e))
(js-await [_ (rlog/load-tail log 500)]
(do (.emit ^js client "ready")
client)))))))))))))))))
;; ---- class surface ---------------------------------------------------------
(unchecked-set ChatClient "join" (fn [opts] (join opts)))
(let [proto (.-prototype ChatClient)]
(js/Object.defineProperty
proto "myAuthorId"
(j/ordered "get" (fn [] (this-as self (unchecked-get (unchecked-get self "log") "myAuthorId")))
"configurable" true))
(unchecked-set proto "peers" (fn [] (this-as self (peers self))))
(unchecked-set proto "history" (fn [] (this-as self (history self))))
(unchecked-set proto "send" (fn [text thread] (this-as self (send self text thread))))
(unchecked-set proto "react" (fn [target emoji op] (this-as self (react self target emoji op))))
(unchecked-set proto "setName" (fn [name] (this-as self (set-name self name))))
(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))))
(unchecked-set proto "_onLive" (fn [from payload] (this-as self (on-live self from payload))))
(unchecked-set proto "_onPeerState" (fn [peer state name] (this-as self (on-peer-state self peer state name))))
(unchecked-set proto "_applyReaction" (fn [m emoji author op] (this-as self (apply-reaction self m emoji author op))))
(unchecked-set proto "_foldReactionsInto" (fn [m] (this-as self (fold-reactions-into self m))))
(unchecked-set proto "_idFields" (fn [] (this-as self (id-fields self))))
(unchecked-set proto "_sendHello" (fn [peer] (this-as self (send-hello self peer)))))
|