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 | ;; ported-from: src/selftest.ts @ v1.2.0
;;
;; Dev-only self-test: canon, envelopes, pair channels, folds, receipts.
(ns ardegazu.social.selftest
(:require [ardegazu.id.identity :as id-identity]
[ardegazu.id.xkey :as id-xkey]
[ardegazu.social.canon :as canon]
[ardegazu.social.envelope :as envelope]
[ardegazu.social.friends :as friends]
[ardegazu.social.pair :as pair]
[ardegazu.social.receipts :as receipts]
[ardegazu.social.selfsync :as selfsync]
[shadow.cljs.modern :refer (js-await)]))
(defn- check [cond what]
(when-not cond
(throw (js/Error. (str "social-kit self-test FAILED: " what)))))
(defn- ensure-local-storage []
;; node has no localStorage — dev-only in-memory shim for the stores
(when (identical? (js* "typeof globalThis.localStorage") "undefined")
(let [m (js/Map.)]
(unchecked-set js/globalThis "localStorage"
(js-obj "getItem" (fn [k] (let [v (.get m k)]
(if (identical? v js/undefined) nil v)))
"setItem" (fn [k v] (.set m k v) js/undefined)
"removeItem" (fn [k] (.delete m k) js/undefined))))))
(defn- mk-self [name]
(let [seed (.newSeed ^js id-identity/Identity)]
(js-await [identity (.fromSeed ^js id-identity/Identity seed)]
(js-await [x (id-xkey/derive-suite-x-key-pair seed)]
(js-await [cert (id-xkey/sign-x-cert identity id-xkey/SUITE-SALT (unchecked-get x "pubB64"))]
(js-obj "identity" identity "x" x "xCert" cert "name" name "seed" seed))))))
(defn- pub-of [actor]
(unchecked-get (unchecked-get actor "identity") "publicKeyB64"))
(defn- envelope-part [a b]
;; envelope roundtrip + context binding + tamper rejection
(js-await [built (envelope/build-envelope a (pair/env-ctx (pub-of b)) (pub-of b)
(unchecked-get (unchecked-get b "x") "pubB64")
"freq" (js-obj "msg" "salut") js/undefined)]
(js-await [opened (envelope/open-envelope (unchecked-get b "x") (pair/env-ctx (pub-of b))
(unchecked-get built "bytes"))]
(check (and (some? opened)
(identical? (unchecked-get opened "t") "freq")
(identical? (unchecked-get (unchecked-get opened "from") "pub") (pub-of a)))
"envelope roundtrip")
(check (and (identical? (unchecked-get (unchecked-get opened "from") "name") "ana")
(identical? (unchecked-get (unchecked-get opened "body") "msg") "salut"))
"envelope content")
(js-await [wrong-ctx (envelope/open-envelope (unchecked-get b "x") (pair/env-ctx (pub-of a))
(unchecked-get built "bytes"))]
(check (nil? wrong-ctx) "envelope ctx-bound")
(js-await [wrong-key (envelope/open-envelope (unchecked-get a "x") (pair/env-ctx (pub-of b))
(unchecked-get built "bytes"))]
(check (nil? wrong-key) "envelope sealed to recipient")
(let [s (.decode (js/TextDecoder.) (unchecked-get built "bytes"))
mid (bit-shift-right (.-length s) 1)
flipped (str (.slice s 0 mid)
(if (identical? (.charAt s mid) "A") "B" "A")
(.slice s (inc mid)))
tampered (.encode (js/TextEncoder.) flipped)]
(js-await [t-opened (envelope/open-envelope (unchecked-get b "x") (pair/env-ctx (pub-of b)) tampered)]
(check (nil? t-opened) "tamper drop")
opened)))))))
(defn- pair-part [a b]
;; pair channel: both sides derive identical channel, seal/open works,
;; outsider tags never match, self channel differs from pair channel
(js-await [ch-a (pair/pair-channel (unchecked-get a "x") (pub-of a) (pub-of b)
(unchecked-get (unchecked-get b "x") "pubB64"))]
(js-await [ch-b (pair/pair-channel (unchecked-get b "x") (pub-of b) (pub-of a)
(unchecked-get (unchecked-get a "x") "pubB64"))]
(check (and (identical? (unchecked-get ch-a "topic") (unchecked-get ch-b "topic"))
(identical? (unchecked-get ch-a "mailboxRoomId") (unchecked-get ch-b "mailboxRoomId")))
"pair channel symmetric")
(js-await [wire ((unchecked-get ch-a "seal") (pub-of a) (js-obj "k" "b" "name" "ana"))]
(js-await [rx ((unchecked-get ch-b "open") wire #js [(pub-of a)])]
(check (and (some? rx)
(identical? (unchecked-get (unchecked-get rx "payload") "name") "ana"))
"pair seal/open")
(js-await [eve (mk-self "eve")]
(js-await [ch-eve (pair/pair-channel (unchecked-get eve "x") (pub-of eve) (pub-of b)
(unchecked-get (unchecked-get b "x") "pubB64"))]
(check (not (identical? (unchecked-get ch-eve "topic") (unchecked-get ch-a "topic")))
"outsider derives a different channel")
(js-await [wrong ((unchecked-get ch-b "open") wire #js [(pub-of eve)])]
(check (nil? wrong) "wrong member list rejected")
(js-await [self-ch (pair/self-channel (unchecked-get a "seed"))]
(js-await [self-ch2 (pair/self-channel (unchecked-get a "seed"))]
(check (and (identical? (unchecked-get self-ch "topic") (unchecked-get self-ch2 "topic"))
(not (identical? (unchecked-get self-ch "topic") (unchecked-get ch-a "topic"))))
"self channel deterministic + distinct")
(js-await [inbox1 (pair/inbox-room-id (pub-of a))]
(js-await [inbox2 (pair/inbox-room-id (pub-of a))]
(check (identical? inbox1 inbox2) "inbox id stable")
eve))))))))))))
(defn- friends-part [a b eve opened]
;; friends: request/accept fold + block + cross-device merge
(let [store-b (friends/FriendStore. "t1")]
(check (friends/apply-friend-envelope store-b opened js/undefined js/undefined) "freq applies")
(check (let [f (.get ^js store-b (pub-of a))]
(and (some? f) (identical? (unchecked-get f "state") "in")))
"request pending")
(.markFriend ^js store-b (pub-of a))
(let [store-b2 (friends/FriendStore. "t2")]
(check (identical? 1 (.merge ^js store-b2 (.socBlob ^js store-b))) "merge adds")
(check (let [f (.get ^js store-b2 (pub-of a))]
(and (some? f) (identical? (unchecked-get f "state") "friend")))
"merge keeps state")
(.block ^js store-b2 (pub-of a))
(check (identical? 0 (.merge ^js store-b2 (.socBlob ^js store-b))) "tombstone beats re-add")
(let [evil (js-obj "v" 1
"friends" #js [(js-obj "pub" "__proto__" "x" "x" "xs" "y" "state" "friend")]
"blocked" #js []
"ts" 0)]
(check (identical? 0 (.merge ^js store-b2 evil)) "malformed records dropped"))
;; forged fsync: inbox ids are public, so eve can seal a VALID envelope
;; (signed with her own key) into b's inbox — the self-origin guard must
;; drop it before anything folds
(let [evil-soc (js-obj "v" 1
"friends" #js [(js-obj "pub" (pub-of eve)
"x" (unchecked-get (unchecked-get eve "x") "pubB64")
"xs" (unchecked-get eve "xCert")
"pet" ""
"name" "bestie"
"state" "friend"
"addedTs" (js/Date.now)
"petTs" 0
"lastSeenTs" 0
"lastApp" "")]
"blocked" #js []
"ts" (js/Date.now))]
(js-await [forged-sync (envelope/build-envelope eve (pair/env-ctx (pub-of b)) (pub-of b)
(unchecked-get (unchecked-get b "x") "pubB64")
"fsync" (js-obj "soc" evil-soc) js/undefined)]
(js-await [forged-opened (envelope/open-envelope (unchecked-get b "x") (pair/env-ctx (pub-of b))
(unchecked-get forged-sync "bytes"))]
(check (some? forged-opened) "forged fsync opens (the envelope itself is valid)")
(let [store-b3 (friends/FriendStore. "t3")]
(check (identical? false (friends/apply-friend-envelope store-b3 forged-opened (js-obj) (pub-of b)))
"forged fsync dropped by self-origin guard")
(check (zero? (.-length ^js (.list ^js store-b3))) "forged fsync folded nothing")
(js-await [own-sync (envelope/build-envelope b (pair/env-ctx (pub-of b)) (pub-of b)
(unchecked-get (unchecked-get b "x") "pubB64")
"fsync" (js-obj "soc" (.socBlob ^js store-b)) js/undefined)]
(js-await [own-opened (envelope/open-envelope (unchecked-get b "x") (pair/env-ctx (pub-of b))
(unchecked-get own-sync "bytes"))]
(check (identical? true (friends/apply-friend-envelope store-b3 own-opened (js-obj) (pub-of b)))
"own fsync still folds")
nil)))))))))
(defn- profile-part []
;; profile self-sync: blank never clobbers, newest wins, backfill only, idempotent
(let [p (fn [name hue glyph lang ts]
(js-obj "name" name "hue" hue "glyph" glyph "lang" lang "ts" ts))
real (p "ana" 12 "🦊" "ro" 1000)
blank (p "" nil nil nil 9000)]
(check (identical? (canon/canon (selfsync/fold-profile-sync real blank)) (canon/canon real))
"blank import never clobbers a real profile")
(let [newer (p "ana!" nil nil nil 2000)]
(check (identical? (canon/canon (selfsync/fold-profile-sync real newer)) (canon/canon newer))
"newer non-blank wins wholesale")
(let [older (p "bea" 200 "🐝" "hu" 1)
holes (p "" nil "🦊" nil 1000)
filled (selfsync/fold-profile-sync holes older)]
(check (and (identical? (unchecked-get filled "name") "bea")
(identical? (unchecked-get filled "hue") 200)
(identical? (unchecked-get filled "glyph") "🦊")
(identical? (unchecked-get filled "lang") "hu")
(identical? (unchecked-get filled "ts") 1000))
"older only backfills blanks")
(check (identical? (canon/canon (selfsync/fold-profile-sync holes (selfsync/fold-profile-sync holes older)))
(canon/canon filled))
"backfill fold idempotent")
(let [tie-a (p "ana" 12 nil nil 500)
tie-b (p "zoe" nil nil nil 500)
tied (selfsync/fold-profile-sync tie-a tie-b)]
(check (identical? (canon/canon tied) (canon/canon (selfsync/fold-profile-sync tie-b tie-a)))
"equal-ts fold converges both ways")
(let [tie-win-name (unchecked-get (if (pos? (compare (canon/canon tie-a) (canon/canon tie-b)))
tie-a tie-b)
"name")]
(check (and (identical? (unchecked-get tied "name") tie-win-name)
(identical? (unchecked-get tied "hue") 12)
(identical? (unchecked-get tied "ts") 500))
"equal-ts tiebreak deterministic"))
(check (identical? (canon/canon (selfsync/fold-profile-sync tie-a tied)) (canon/canon tied))
"equal-ts fold idempotent")
(check (identical? (canon/canon (selfsync/fold-profile-sync older (selfsync/fold-profile-sync older real)))
(canon/canon (selfsync/fold-profile-sync older real)))
"wholesale fold idempotent")
(check (and (nil? (selfsync/sanitize-profile-sync nil))
(nil? (selfsync/sanitize-profile-sync (js-obj "name" "x"))))
"profile sync shape-checked")
(let [dirty (selfsync/sanitize-profile-sync
(js-obj "name" (.repeat "x" 99)
"hue" 720
"glyph" "ab"
"lang" "no way"
"ts" (+ (js/Date.now) (* 999 86400000))))]
(check (and (identical? 32 (.-length (js/Array.from (unchecked-get dirty "name"))))
(identical? (unchecked-get dirty "hue") nil)
(identical? (unchecked-get dirty "glyph") "a")
(identical? (unchecked-get dirty "lang") nil)
(<= (unchecked-get dirty "ts") (+ (js/Date.now) 120000)))
"profile sync clamped")
nil))))))
(defn- apps-part []
;; apps self-sync: per-key newest-wins, converging equal-ts tiebreak, keys
;; that never drag each other, and the shape clamps
(let [ent (fn [state ts] (js-obj "state" state "ts" ts))
ts-of (fn [m k] (unchecked-get (unchecked-get m k) "ts"))
local (js-obj "board" (ent (js-obj "n" 2) 3000)
"chat" (ent (js-obj "n" 1) 1000))
remote (js-obj "chat" (ent (js-obj "n" 9) 2000)
"game1" (ent (js-obj "n" 3) 500))
folded (selfsync/fold-apps-sync local remote)]
(check (identical? (ts-of folded "chat") 2000) "newer entry wins its key wholesale")
(check (identical? (ts-of folded "board") 3000) "a key only the local side has survives")
(check (identical? (ts-of folded "game1") 500)
"a key only the remote side has is adopted, however old")
(check (identical? (canon/canon folded)
(canon/canon (selfsync/fold-apps-sync remote local)))
"apps fold commutes")
(check (identical? (canon/canon (selfsync/fold-apps-sync local folded))
(canon/canon folded))
"apps fold idempotent")
;; per-key independence: one newer key must not carry a stale sibling in
;; with it — the whole reason this fold is not the profile's
(let [mixed (selfsync/fold-apps-sync local (js-obj "board" (ent (js-obj "n" 7) 9000)
"chat" (ent (js-obj "n" 0) 1)))]
(check (and (identical? (ts-of mixed "board") 9000)
(identical? (ts-of mixed "chat") 1000))
"each key folds on its own timestamp"))
(let [tie-a (js-obj "chat" (ent (js-obj "n" 1) 777))
tie-b (js-obj "chat" (ent (js-obj "n" 2) 777))
ab (selfsync/fold-apps-sync tie-a tie-b)]
(check (identical? (canon/canon ab) (canon/canon (selfsync/fold-apps-sync tie-b tie-a)))
"equal-ts apps fold converges from both roles")
(check (identical? (canon/canon (selfsync/fold-apps-sync ab tie-a)) (canon/canon ab))
"equal-ts apps fold idempotent"))
(check (and (nil? (selfsync/sanitize-apps-sync nil))
(nil? (selfsync/sanitize-apps-sync #js []))
(nil? (selfsync/sanitize-apps-sync (js-obj)))
(nil? (selfsync/sanitize-apps-sync (js-obj "chat" (js-obj "state" 1)))))
"apps sync shape-checked")
;; "constructor" matches the app-key charset and must fold as ordinary
;; data; "__proto__" is what JSON.parse of wire text produces and must
;; never reach the output's prototype setter (the key vanishes and the
;; entry becomes the map's prototype).
(let [wire (js/JSON.parse "{\"__proto__\":{\"state\":\"p\",\"ts\":9},\"constructor\":{\"state\":\"c\",\"ts\":9}}")
f (selfsync/fold-apps-sync wire (js-obj))]
(check (identical? (canon/canon (js/Object.keys f)) "[\"constructor\"]")
"the fold drops __proto__ and keeps constructor as data")
(check (and (identical? (js/Object.getPrototypeOf f) (.-prototype js/Object))
(identical? (unchecked-get f "state") js/undefined))
"the fold's output is not poisonable through __proto__")
(check (identical? (canon/canon (js/Object.keys
(selfsync/sanitize-apps-sync wire)))
"[\"constructor\"]")
"sanitize drops __proto__ too"))
(let [dirty (selfsync/sanitize-apps-sync
(js-obj "zed" (ent 1 5)
"chat" (ent (js-obj "ok" true) (+ (js/Date.now) (* 999 86400000)))
"BAD KEY" (ent 1 5)
"big" (ent (.repeat "x" 20000) 5)
"nan" (ent 1 js/NaN)))]
(check (identical? (canon/canon (js/Object.keys dirty)) "[\"chat\",\"zed\"]")
"apps sync drops bad keys and entries, and emits in a fixed order")
;; clamped to NOW, not to now + skew: a section emitted from the future
;; freezes its key on the emitting device and re-hashes every round
(check (<= (ts-of dirty "chat") (js/Date.now)) "apps sync ts clamped to now, never ahead of it")
(check (identical? (ts-of dirty "zed") 5) "an honest past ts is left exactly alone")
nil)))
(defn- link-part [a b]
;; friend link roundtrip + forged-cert rejection
(let [link (friends/build-friend-link "https://ardegazu.ro/"
(js-obj "pub" (pub-of a)
"x" (unchecked-get (unchecked-get a "x") "pubB64")
"xs" (unchecked-get a "xCert")
"name" "ana"))]
(js-await [parsed (friends/parse-friend-link (.-hash (js/URL. link)))]
(check (and (some? parsed)
(identical? (unchecked-get parsed "pub") (pub-of a))
(identical? (unchecked-get parsed "name") "ana"))
"friend link roundtrip")
(let [forged (.replace ^js link
(unchecked-get (unchecked-get a "x") "pubB64")
(unchecked-get (unchecked-get b "x") "pubB64"))]
(js-await [forged-parsed (friends/parse-friend-link (.-hash (js/URL. forged)))]
(check (nil? forged-parsed) "forged link cert rejected")
nil)))))
(defn- receipts-part [a b eve]
;; receipts: co-sign, verify, forgery + duplicate rejection
(let [base (js-obj "v" 1
"g" "game1.ardegazu.ro/v2"
"m" "classic"
"r" "roomhashroomhashroomha"
"ts" (js/Date.now)
"n" 2
"sc" #js [(js-obj "p" (pub-of a) "nm" "ana" "s" 420)
(js-obj "p" (pub-of b) "nm" "bogdan" "s" 300)])]
(js-await [sig-a (receipts/sign-receipt (unchecked-get a "identity") base)]
(js-await [sig-b (receipts/sign-receipt (unchecked-get b "identity") base)]
(let [rec (js/Object.assign (js-obj) base)]
(unchecked-set rec "sig" #js [sig-a sig-b])
(js-await [v (receipts/verify-receipt rec js/undefined)]
(check (some? v) "co-signed receipt verifies")
(let [one-sig (js/Object.assign (js-obj) rec)]
(unchecked-set one-sig "sig" #js [sig-a])
(js-await [v1 (receipts/verify-receipt one-sig js/undefined)]
(check (nil? v1) "1-sig receipt rejected")
(let [cooked (js/Object.assign (js-obj) rec)
sc0 (js/Object.assign (js-obj) (aget (unchecked-get rec "sc") 0))]
(unchecked-set sc0 "s" 999999)
(unchecked-set cooked "sc" #js [sc0 (aget (unchecked-get rec "sc") 1)])
(js-await [v2 (receipts/verify-receipt cooked js/undefined)]
(check (nil? v2) "tampered score rejected")
(js-await [outsider-sig (receipts/sign-receipt (unchecked-get eve "identity") base)]
(let [with-outsider (js/Object.assign (js-obj) rec)]
(unchecked-set with-outsider "sig" #js [sig-a outsider-sig])
(js-await [v3 (receipts/verify-receipt with-outsider js/undefined)]
(check (nil? v3) "non-player signer rejected")
(js-await [h1 (receipts/receipt-hash rec)]
(js-await [h2 (receipts/receipt-hash base)]
(check (identical? h1 h2) "hash ignores sigs")
(check (.test #"^\d{4}-W\d{2}$" (receipts/iso-week (js/Date.now))) "iso week shape")
(let [rows (receipts/aggregate #js [rec])]
(check (and (identical? (unchecked-get (aget rows 0) "pub") (pub-of a))
(identical? (unchecked-get (aget rows 0) "best") 420))
"aggregate top row")
nil))))))))))))))))
(defn run-social-kit-self-test []
(-> (js/Promise.resolve nil)
(.then
(fn [_]
(ensure-local-storage)
;; canon: key order + undefined dropping
(check (identical? (canon/canon (js-obj "b" 1
"a" #js [2 (js-obj "z" nil "y" "s")]
"c" js/undefined))
"{\"a\":[2,{\"y\":\"s\",\"z\":null}],\"b\":1}")
"canon shape")
(js-await [a (mk-self "ana")]
(js-await [b (mk-self "bogdan")]
(js-await [opened (envelope-part a b)]
(js-await [eve (pair-part a b)]
(js-await [_ (friends-part a b eve opened)]
(profile-part)
(apps-part)
(js-await [_ (link-part a b)]
(js-await [_ (receipts-part a b eve)]
(js/console.info "✅ social-kit self-test passed")
js/undefined)))))))))))
|