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 | ;; The demo store: a shared, replicated note wall projected from the room log,
;; plus the live-channel plumbing every rooms app wants (name announcements and
;; same-identity room-list sync).
;;
;; ============================ READ THIS FIRST ==============================
;; THE DEMO RIDES CHAT'S {t:"chat"} LOG OP, so this scaffold compiles and runs
;; day zero on top of the shared rooms core it gets from ardegazu-rooms-kit
;; (ardegazu.rooms.*, compiled off the classpath — see client/deps.edn). When you
;; build your real app: define your own LogOp union in lib/protocol.cljs, then
;; replace the {t:"chat"} append/projection below with your ops. The core does
;; not care what shape your ops are — it seals and replicates opaque payloads.
;; Your APP-SALT (config.cljs) already guarantees your rooms can never collide
;; with chat's, whatever the op shapes are.
;; ===========================================================================
;;
;; Projector pattern: state is NEVER mutated directly — post! appends an op to
;; the encrypted log, and apply-entry folds ops back into state, whether they
;; are local echoes, live replication, device-local replay (load-tail) or
;; mailbox deliveries. One code path, every transport.
;;
;; PORT NOTES (dev/docs/CLJS.md)
;; - every op and every live payload is a WIRE shape: built with j/ordered
;; (sequential unchecked-set), never `#js {}` — key order silently becomes
;; hash order at nine pairs. Pin them with golden vectors when you add tests.
;; - a Note is a plain mutable JS object; the UI reads it directly.
;; - `if (!text)` / `e.from || ""` are JS truthiness — j/truthy?, not `when`.
;; - validators use the JS forms (js/Array.isArray, `typeof`), because a
;; validator IS the wire contract.
(ns __NAME__.app.store
(:require ["ardegazu-id-kit" :refer (verifyAssertion)]
[__NAME__.config :as config]
[ardegazu.rooms.js :as j]
[ardegazu.rooms.lib.net :as net]
[shadow.cljs.modern :refer (defclass js-await)]))
(defn- ^boolean arr? [x] (js/Array.isArray x))
(defn- ^boolean s? [x] (identical? "string" (js* "typeof ~{}" x)))
(defn- ^boolean n? [x] (identical? "number" (js* "typeof ~{}" x)))
(defn- clamp-ts
"Bogus remote timestamps must not pin entries to the far future/past forever."
[ts]
(let [now (js/Date.now)]
(if-not (and (n? ts) (js/Number.isFinite ts))
now
(js/Math.min (js/Math.max ts 0) (+ now 120000)))))
(declare add-note! id-fields verify-peer-identity on-room-sync)
;; A Note is {id, from, name, ts, text, mine} — six keys.
;; `self` (the identity assertion) is {pub, sig, hue?, glyph?}; nil on a browser
;; without WebCrypto Ed25519.
(defclass NoteStore
(constructor [this net log name room self]
(unchecked-set this "notes" (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 "_room" room)
(unchecked-set this "_self" self)
;; 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))
;; Fired for LIVE incoming notes 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
;; per peer.
(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 (a roomsync can arrive right behind the hello that proves
;; its sender)
(unchecked-set this "_verifiedPub" (js/Map.))
(unchecked-set this "_verifying" (js/Map.))
(unchecked-set this "_selfDeviceSeen" (js/Set.)) ; send-once per peer
(unchecked-set this "_roomSyncSeen" (js/Set.)))) ; receive-once per peer
(defn my-name [self]
(unchecked-get self "_name"))
(defn set-name [self name]
(unchecked-set self "_name" name)
(let [payload (j/ordered "kind" "name" "name" name)]
(j/oset* payload (id-fields self))
(.catch (js/Promise.resolve (net/broadcast (unchecked-get self "_net") payload))
(fn [_] nil)))
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]
(let [payload (j/ordered "kind" "hello" "name" (unchecked-get self "_name"))]
(j/oset* payload (id-fields self))
(.catch (js/Promise.resolve (net/send-to (unchecked-get self "_net") peer payload))
(fn [_] nil)))
js/undefined)
(defn- id-fields
"Identity binding attached to hello/name so peers can verify who's talking.
Returns a flat k v … seq for j/oset* (order preserved)."
[self]
(let [me (unchecked-get self "_self")]
(if-not (j/truthy? me)
nil
(let [hue (unchecked-get me "hue")
glyph (unchecked-get me "glyph")]
(concat ["idPub" (unchecked-get me "pub")
"idSig" (unchecked-get me "sig")]
(when (n? hue) ["hue" hue])
(when (j/truthy? glyph) ["glyph" glyph]))))))
(defn post!
"Append a note. It comes back through apply-entry like everyone else's."
[self text]
(let [trimmed (.trim ^string text)]
(when (j/truthy? trimmed)
;; a chat LogOp: {t, ts, name, text} — four keys, the TS literal's order
(.catch (.append ^js (unchecked-get self "_log")
(j/ordered "t" "chat" "ts" (js/Date.now)
"name" (unchecked-get self "_name") "text" trimmed))
(fn [_] nil))))
js/undefined)
;; ---- the projector: log entries → state ------------------------------------
(defn apply-entry [self e]
;; the demo folds only the chat text op; every other op chat happens to
;; write ({t:"img"|"react"|"name"|"call"|"legacy"}) is ignored on purpose
(let [op (unchecked-get e "op")]
(when (identical? "chat" (unchecked-get op "t"))
(let [text (unchecked-get op "text")]
(when (and (s? text) (j/truthy? text))
(let [from (unchecked-get e "from")]
(add-note!
self
(j/ordered "id" (unchecked-get e "hash")
"from" from
"name" (.slice (js* "String(~{})" (j/nn (unchecked-get op "name") "?")) 0 40)
"ts" (clamp-ts (unchecked-get op "ts"))
"text" (.slice ^string text 0 config/MAX-TEXT)
"mine" (and (j/truthy? from)
(identical? from (unchecked-get (unchecked-get self "_log")
"myAuthorId")))))))))
js/undefined))
(defn- add-note! [self note]
(let [by-id ^js (unchecked-get self "_byId")
id (unchecked-get note "id")]
;; deduped across transports by entry hash
(when-not (.has by-id id)
(.set by-id id note)
;; stable insert by (ts, id) — deterministic on every replica
(let [notes ^js (unchecked-get self "notes")
ts (unchecked-get note "ts")]
(loop [i (.-length notes)]
(if (and (pos? i)
(let [prev (aget notes (dec i))]
(not (or (< (unchecked-get prev "ts") ts)
(and (identical? (unchecked-get prev "ts") ts)
(< (unchecked-get prev "id") id))))))
(recur (dec i))
(.splice notes i 0 note)))
(while (> (.-length notes) config/MAX-NOTES)
(let [dropped (.shift notes)]
(.delete by-id (unchecked-get dropped "id")))))
(when (and (unchecked-get self "_live") (not (unchecked-get note "mine")))
((unchecked-get self "onIncoming") note))
((unchecked-get self "onChange"))))
js/undefined)
;; ---- live (non-logged) payloads --------------------------------------------
(defn on-message [self from raw]
(let [p raw]
(when (and (j/truthy? p) (j/js-object? p))
(let [kind (unchecked-get p "kind")]
(cond
(identical? "roomsync" kind) (on-room-sync self from p)
(or (identical? "hello" kind) (identical? "name" kind))
(let [name (.slice (js* "String(~{})" (j/nn (unchecked-get p "name") "?")) 0 40)
id-pub (unchecked-get p "idPub")
id-sig (unchecked-get p "idSig")]
((unchecked-get self "onPeerName") from name)
(when (and (s? id-pub) (s? id-sig))
(let [verifying ^js (unchecked-get self "_verifying")
cell (array nil)
job (.finally (verify-peer-identity self from id-pub id-sig)
(fn []
(when (identical? (.get verifying from) (aget cell 0))
(.delete verifying from))))]
(aset cell 0 job)
(.set verifying from job))))
:else nil))))
js/undefined)
(defn- verify-peer-identity [self from id-pub id-sig]
(js-await [fp (verifyAssertion (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-not (j/truthy? fp)
js/undefined
(do
(.set ^js (unchecked-get self "_verifiedPub") from id-pub)
;; 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 (j/truthy? 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-not (j/truthy? me)
(js/Promise.resolve nil)
(let [pending (.get ^js (unchecked-get self "_verifying") from)]
(-> (if (j/truthy? 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 (arr? rooms)
((unchecked-get self "onRoomSync")
from
(j/ordered "rooms" rooms "gone" (if (arr? gone) gone (array)))))))))
js/undefined)))))))
|