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 | ;; ported-from: src/mailbox.ts @ v1.2.0
;;
;; The managed node's store-and-forward mailbox, generically: open per-room-id
;; bearer mint + bare HTTP deposit/replay. Extracted from the board app's
;; lib/mailbox.ts (MailboxAuth/MailboxClient verbatim, minus the OrbitDB-coupled
;; sync engine) — the social layer deposits sealed envelope bytes into rooms
;; whose ids are client-derived (inboxes, pair drops, leaderboard drops), all
;; opaque HKDF/hash outputs the node cannot correlate with anything.
;;
;; Everything is best-effort: a mailbox failure must never break the live path.
(ns ardegazu.social.mailbox
(:require [ardegazu.social.consts :as consts]
[shadow.cljs.modern :refer (defclass js-await)]))
(def ^:private MINT-TTL-SEC 86400) ; ask for the max (24 h); the node may clamp
;; ---- endpoint discovery (descriptor wins, compiled-in fallback) ------------
(def ^:private cached-endpoints (volatile! nil))
(defn mailbox-endpoints [descriptor-url]
(let [url (if (identical? descriptor-url js/undefined) consts/AP2P-DESCRIPTOR-URL descriptor-url)]
(when (nil? @cached-endpoints)
(vreset!
cached-endpoints
(-> (js/Promise.resolve nil)
(.then (fn [_]
(js-await [res (js/fetch url (js-obj "signal" (js/AbortSignal.timeout 3000)))]
(if ^boolean (.-ok ^js res)
(js-await [d (.json ^js res)]
(let [mb (unchecked-get d "mailbox")
endpoint (when (some? mb) (unchecked-get mb "endpoint"))
mint (when (some? mb) (unchecked-get mb "mint_endpoint"))]
(if (and ^boolean (js* "!!(~{})" endpoint) ^boolean (js* "!!(~{})" mint))
(js-obj "baseUrl" endpoint
"credsUrl" mint
"maxMessageKb" (let [kb (unchecked-get mb "max_message_kb")]
(if (nil? kb) 64 kb)))
(throw (js/Error. "descriptor missing mailbox block")))))
(throw (js/Error. "descriptor not ok"))))))
(.catch (fn [_]
;; fall through to fallback
(js-obj "baseUrl" consts/MAILBOX-URL-FALLBACK
"credsUrl" consts/MAILBOX-CREDS-URL-FALLBACK
"maxMessageKb" 64))))))
@cached-endpoints))
;; ---- auth: browser open-mint, cached bearer --------------------------------
(defclass MailboxAuth
(constructor [this creds-url room-id]
(unchecked-set this "_credsUrl" creds-url)
(unchecked-set this "_roomId" room-id)
(unchecked-set this "_cached" nil)
(unchecked-set this "_validUntil" 0)
(unchecked-set this "_inflight" nil)))
(defn- auth-mint [self]
(let [url (str (unchecked-get self "_credsUrl")
"?room=" (js/encodeURIComponent (unchecked-get self "_roomId"))
"&ttl=" MINT-TTL-SEC)]
(-> (js/Promise.resolve nil)
(.then (fn [_]
(js-await [res (js/fetch url (js-obj "signal" (js/AbortSignal.timeout 15000)))]
(when-not ^boolean (.-ok ^js res)
(throw (js/Error. (str "mailbox mint " (.-status ^js res)))))
(js-await [c (.json ^js res)]
(let [token (unchecked-get c "token")]
(when-not ^boolean (js* "!!(~{})" token)
(throw (js/Error. "mailbox mint: no token")))
(unchecked-set self "_cached" token)
(unchecked-set self "_validUntil"
(- (+ (js/Date.now)
(* (let [ttl (unchecked-get c "ttl")]
(if (nil? ttl) 0 ttl))
1000))
300000)) ; renew 5 min early
token))))))))
(let [proto (.-prototype MailboxAuth)]
(unchecked-set proto "get"
(fn []
(this-as self
(if (and ^boolean (js* "!!(~{})" (unchecked-get self "_cached"))
(< (js/Date.now) (unchecked-get self "_validUntil")))
(js/Promise.resolve (unchecked-get self "_cached"))
(or (unchecked-get self "_inflight")
(let [p (.finally ^js (auth-mint self)
(fn [] (unchecked-set self "_inflight" nil)))]
(unchecked-set self "_inflight" p)
p))))))
;; Drop the cached token (server said 401/403) so the next get() re-mints.
(unchecked-set proto "invalidate"
(fn []
(this-as self
(unchecked-set self "_cached" nil)
(unchecked-set self "_validUntil" 0)
js/undefined))))
;; ---- bare HTTP client with typed results -----------------------------------
(defclass MailboxClient
(constructor [this base-url room-id auth]
(unchecked-set this "_auth" auth)
;; <baseUrl>/rooms/<roomId>/messages
(unchecked-set this "_base"
(str (.replace ^js base-url #"/$" "")
"/rooms/" (js/encodeURIComponent room-id) "/messages"))))
;; One request with the cached bearer; on 401/403 re-mint once and retry.
(defn- client-send [self init qs attempt]
(let [^js auth (unchecked-get self "_auth")]
(if (>= attempt 2)
(js/Promise.resolve nil)
(-> (.get auth)
(.then
(fn [token]
(let [base-init (init)
headers (js/Object.assign (js-obj) (unchecked-get base-init "headers"))
_ (unchecked-set headers "authorization" (str "Bearer " token))
opts (js/Object.assign (js-obj) base-init)]
(unchecked-set opts "headers" headers)
(unchecked-set opts "signal" (js/AbortSignal.timeout 20000))
(-> (js/fetch (str (unchecked-get self "_base") qs) opts)
(.then (fn [res]
(if (and (or (identical? 401 (.-status ^js res))
(identical? 403 (.-status ^js res)))
(identical? attempt 0))
(do (.invalidate auth)
(client-send self init qs (inc attempt)))
res)))
(.catch (fn [_] nil))))))
(.catch (fn [_] nil))))))
(let [proto (.-prototype MailboxClient)]
(unchecked-set
proto "deposit"
(fn [payload]
(this-as self
(-> (client-send self
(fn [] (js-obj "method" "POST"
"headers" (js-obj "content-type" "application/octet-stream")
"body" payload))
"" 0)
(.then
(fn [res]
(cond
(nil? res) (js-obj "ok" false "kind" "net")
(or (identical? 201 (.-status ^js res)) (identical? 200 (.-status ^js res)))
(-> (.json ^js res)
(.then (fn [b]
(js-obj "ok" true
"deduped" ^boolean (js* "!!(~{})" (unchecked-get b "deduped"))
"seq" (let [s (unchecked-get b "seq")] (if (nil? s) "" s)))))
(.catch (fn [_] (js-obj "ok" true "deduped" false "seq" ""))))
(identical? 413 (.-status ^js res)) (js-obj "ok" false "kind" "too_large")
(or (identical? 401 (.-status ^js res)) (identical? 403 (.-status ^js res)))
(js-obj "ok" false "kind" "auth")
:else (js-obj "ok" false
"kind" (if (or (identical? 429 (.-status ^js res))
(identical? 507 (.-status ^js res)))
"backpressure" "net")))))))))
(unchecked-set
proto "replay"
(fn [after limit]
(this-as self
(let [qs (str "?limit=" limit
(if ^boolean (js* "!!(~{})" after)
(str "&after=" (js/encodeURIComponent after)) ""))]
(-> (client-send self (fn [] (js-obj "method" "GET")) qs 0)
(.then
(fn [res]
(cond
(nil? res) (js-obj "ok" false "kind" "net")
(or (identical? 401 (.-status ^js res)) (identical? 403 (.-status ^js res)))
(js-obj "ok" false "kind" "auth")
(not ^boolean (.-ok ^js res))
(js-obj "ok" false "kind" (if (identical? 429 (.-status ^js res)) "backpressure" "net"))
:else
(-> (.json ^js res)
(.then (fn [b]
(let [msgs (unchecked-get b "messages")
oldest (unchecked-get b "oldest_seq")
latest (unchecked-get b "latest_seq")]
(js-obj "ok" true
"page" (js-obj "messages" (if (js/Array.isArray msgs) msgs #js [])
"hasMore" ^boolean (js* "!!(~{})" (unchecked-get b "has_more"))
"oldestSeq" (if (nil? oldest) nil oldest)
"latestSeq" (if (nil? latest) nil latest))))))
(.catch (fn [_] (js-obj "ok" false "kind" "net")))))))))))))
(defn mailbox-for
"Convenience: a client for one client-derived room id."
[room-id]
(js-await [ep (mailbox-endpoints js/undefined)]
(MailboxClient. (unchecked-get ep "baseUrl") room-id
(MailboxAuth. (unchecked-get ep "credsUrl") room-id))))
|