chat / client / src / sueta / app / call.cljs
  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
368
369
370
371
372
373
374
375
376
377
378
379
;; ported-from: src/app/call.ts
;;
;; Room calls (Discord-style): anyone joins the room's single call; membership
;; and mic/cam state travel as E2E-sealed payloads on the room's gossip topic;
;; media rides dedicated per-pair media-only RTCPeerConnections (lib/media.cljs,
;; DTLS-SRTP, own ICE/TURN, SDP sealed over libp2p streams). Members not in the
;; call exchange zero media. docs/PROTOCOL.md v2.
;;
;; A CallMember is {audio, video, name, stream?, staleTimer?} and CallSelf is
;; {micOn, camOn}. The live payload is {kind, op, audio, video, name} — FIVE keys
;; on the wire, built with j/ordered and pinned by test/vectors/call.json.
(ns sueta.app.call
  (:require [sueta.i18n :refer (t)]
            [ardegazu.rooms.js :as j]
            [shadow.cljs.modern :refer (defclass js-await)]))

(def ^:private AUDIO-WARN 8)
(def ^:private VIDEO-MAX 4)
;; one cap for direct AND relayed legs: coturn allows 5 Mbps per allocation, so
;; relayed video needs no lower ceiling (v8)
(def ^:private VIDEO-KBPS 450)
(def ^:private STALE-MS 15000)

(defn- ^boolean ios? []
  (or (.test (js/RegExp. "iP(hone|ad|od)") (.-userAgent js/navigator))
      (and (> (.-maxTouchPoints js/navigator) 1)
           (.test (js/RegExp. "Mac") (.-userAgent js/navigator)))))

(defn- video-constraints []
  (j/ordered "facingMode" "user"
             "width" (j/ordered "ideal" 640)
             "height" (j/ordered "ideal" 480)
             "frameRate" (j/ordered "ideal" 24 "max" 30)))

(def ^:private AUDIO-CONSTRAINTS
  (j/ordered "echoCancellation" true "noiseSuppression" true "autoGainControl" true))

(defn- gum-error-message
  "getUserMedia failures are not all permission problems — say which it was."
  [err]
  (let [n (when (j/truthy? err) (unchecked-get err "name"))]
    (cond
      (or (identical? "NotFoundError" n) (identical? "OverconstrainedError" n)) (t "call.err.no-device")
      (identical? "NotReadableError" n) (t "call.err.busy")
      :else (t "call.err.denied"))))

(declare attach! drop-member! video-count state-payload broadcast! wake! recover-tracks!)

(defclass CallManager
  (constructor [this net media my-name]
    (unchecked-set this "_net" net)
    (unchecked-set this "_media" media)
    (unchecked-set this "_myName" my-name)
    (unchecked-set this "_local" nil)
    (unchecked-set this "_wakeLock" nil)
    ;; getUserMedia can hang on a permission prompt for seconds; a second tap in
    ;; that window must not acquire a second stream (the orphan keeps the mic hot
    ;; with no way to release it). One flag guards join AND cam toggling.
    (unchecked-set this "_acquiring" false)
    (unchecked-set this "status" "idle")
    (unchecked-set this "micOn" true)
    (unchecked-set this "camOn" false)
    (unchecked-set this "members" (js/Map.))
    (unchecked-set this "onRoster" (fn [_ _] js/undefined))
    ;; Fired when I start the room's call (I joined and nobody was in it).
    (unchecked-set this "onStartedCall" (fn [] js/undefined))
    (unchecked-set this "onError" (fn [_] js/undefined))
    ;; UI warning channel (scale limits etc.).
    (unchecked-set this "onNotice" (fn [_] js/undefined))
    (.addEventListener js/document "visibilitychange"
                       (fn []
                         (when (and (identical? "visible" (.-visibilityState js/document))
                                    (identical? "in-call" (unchecked-get this "status")))
                           (recover-tracks! this))
                         js/undefined))))

(defn local-stream [self] (unchecked-get self "_local"))

(defn ^boolean active?
  "Anyone (me or others) in the call? Drives the callbar visibility."
  [self]
  (or (identical? "in-call" (unchecked-get self "status"))
      (pos? (.-size ^js (unchecked-get self "members")))))

(defn self-state [self]
  (if (identical? "in-call" (unchecked-get self "status"))
    (j/ordered "micOn" (unchecked-get self "micOn") "camOn" (unchecked-get self "camOn"))
    nil))

(defn- stop-tracks! [stream]
  (when (j/truthy? stream)
    (.forEach (.getTracks ^js stream) (fn [track] (.stop ^js track))))
  js/undefined)

(defn join [self with-video]
  (if (or (identical? "in-call" (unchecked-get self "status"))
          (j/truthy? (unchecked-get self "_acquiring")))
    (js/Promise.resolve nil)
    (let [members ^js (unchecked-get self "members")
          want-video (volatile! with-video)]
      (when (> (inc (.-size members)) AUDIO-WARN)
        ((unchecked-get self "onNotice") (t "call.mesh-warn" {"n" AUDIO-WARN})))
      (when (and (j/truthy? @want-video) (>= (video-count self) VIDEO-MAX))
        (vreset! want-video false)
        ((unchecked-get self "onNotice") (t "call.video-cap-joined" {"n" VIDEO-MAX})))
      (unchecked-set self "_acquiring" true)
      (-> (js/Promise.resolve nil)
          (.then (fn [_]
                   (let [c (j/ordered "audio" AUDIO-CONSTRAINTS)]
                     (when (j/truthy? @want-video) (unchecked-set c "video" (video-constraints)))
                     (js-await [stream (.getUserMedia (.-mediaDevices js/navigator) c)]
                       (do
                         ;; defensive: never orphan a stream
                         (stop-tracks! (unchecked-get self "_local"))
                         (unchecked-set self "_local" stream)
                         ::ok)))))
          (.catch (fn [err]
                    ((unchecked-get self "onError") (gum-error-message err))
                    ::failed))
          (.then
           (fn [outcome]
             (unchecked-set self "_acquiring" false)
             (when-not (keyword-identical? ::failed outcome)
               (let [started-it (identical? 0 (.-size members))]
                 (unchecked-set self "status" "in-call")
                 (unchecked-set self "micOn" true)
                 (unchecked-set self "camOn" @want-video)
                 (wake! self)
                 (broadcast! self "join")
                 (when started-it ((unchecked-get self "onStartedCall")))
                 (doseq [peer-id (array-seq (js/Array.from (.keys members)))] (attach! self peer-id))
                 ((unchecked-get self "onRoster") (self-state self) members)))
             js/undefined))))))

(defn leave [self]
  (when (identical? "in-call" (unchecked-get self "status"))
    (broadcast! self "leave")
    (.detachAllMedia ^js (unchecked-get self "_media"))
    (stop-tracks! (unchecked-get self "_local"))
    (unchecked-set self "_local" nil)
    (unchecked-set self "status" "idle")
    (unchecked-set self "camOn" false)
    (let [lock (unchecked-get self "_wakeLock")]
      (when (j/truthy? lock) (.catch (.release ^js lock) (fn [_] nil))))
    (unchecked-set self "_wakeLock" nil)
    ((unchecked-get self "onRoster") nil (unchecked-get self "members")))
  js/undefined)

(defn toggle-mic [self]
  (let [stream (unchecked-get self "_local")
        track (when (j/truthy? stream) (aget (.getAudioTracks ^js stream) 0))]
    (when (j/truthy? track)
      (unchecked-set self "micOn" (not (j/truthy? (unchecked-get self "micOn"))))
      (set! (.-enabled ^js track) (unchecked-get self "micOn"))
      (broadcast! self "state")
      ((unchecked-get self "onRoster") (self-state self) (unchecked-get self "members"))))
  js/undefined)

(defn toggle-cam [self]
  (if (or (not (j/truthy? (unchecked-get self "_local")))
          (j/truthy? (unchecked-get self "_acquiring")))
    (js/Promise.resolve nil)
    (if-not (j/truthy? (unchecked-get self "camOn"))
      (if (>= (video-count self) VIDEO-MAX)
        (do ((unchecked-get self "onNotice") (t "call.video-cap" {"n" VIDEO-MAX}))
            (js/Promise.resolve nil))
        (do
          (unchecked-set self "_acquiring" true)
          (-> (js/Promise.resolve nil)
              (.then
               (fn [_]
                 (if (ios?)
                   ;; iOS: a second getUserMedia can kill the live mic —
                   ;; re-acquire both
                   (js-await [fresh (.getUserMedia (.-mediaDevices js/navigator)
                                                   (j/ordered "audio" AUDIO-CONSTRAINTS
                                                              "video" (video-constraints)))]
                     (do
                       (stop-tracks! (unchecked-get self "_local"))
                       (unchecked-set self "_local" fresh)
                       (set! (.-enabled (aget (.getAudioTracks ^js fresh) 0)) (unchecked-get self "micOn"))
                       ::ok))
                   (js-await [cam (.getUserMedia (.-mediaDevices js/navigator)
                                                 (j/ordered "video" (video-constraints)))]
                     (do (.addTrack ^js (unchecked-get self "_local") (aget (.getVideoTracks ^js cam) 0))
                         ::ok)))))
              (.catch (fn [err]
                        ((unchecked-get self "onError") (gum-error-message err))
                        ::failed))
              (.then
               (fn [outcome]
                 (unchecked-set self "_acquiring" false)
                 (when-not (keyword-identical? ::failed outcome)
                   (unchecked-set self "camOn" true)
                   (doseq [peer-id (array-seq (js/Array.from (.keys ^js (unchecked-get self "members"))))]
                     (attach! self peer-id))
                   (broadcast! self "state")
                   ((unchecked-get self "onRoster") (self-state self) (unchecked-get self "members")))
                 js/undefined)))))
      (do
        (let [local ^js (unchecked-get self "_local")]
          (doseq [track (array-seq (js/Array.from (.getVideoTracks local)))]
            (.stop ^js track)
            (.removeTrack local track)))
        (unchecked-set self "camOn" false)
        (doseq [peer-id (array-seq (js/Array.from (.keys ^js (unchecked-get self "members"))))]
          (attach! self peer-id))
        (broadcast! self "state")
        ((unchecked-get self "onRoster") (self-state self) (unchecked-get self "members"))
        (js/Promise.resolve nil)))))

;; ---- mesh event handlers (wired in room.cljs) -------------------------------

(defn on-wire [self from raw]
  (let [p raw]
    (when (identical? "call" (when (j/truthy? p) (unchecked-get p "kind")))
      (let [name (.slice (js* "String(~{})" (j/nn (unchecked-get p "name") "?")) 0 40)
            op (unchecked-get p "op")
            members ^js (unchecked-get self "members")]
        (cond
          (identical? "leave" op)
          (do (drop-member! self from)
              (.dropPeer ^js (unchecked-get self "_media") from))

          (or (identical? "join" op) (identical? "state" op))
          (let [existing (.get members from)
                m (if (identical? existing js/undefined)
                    (j/ordered "audio" true "video" false "name" name)
                    existing)]
            ;; `audio !== false` / `video === true`: absent means audio on,
            ;; video off
            (unchecked-set m "audio" (not (false? (unchecked-get p "audio"))))
            (unchecked-set m "video" (true? (unchecked-get p "video")))
            (unchecked-set m "name" name)
            (.set members from m)
            (when (and (identical? "join" op) (identical? "in-call" (unchecked-get self "status")))
              (.sendTo ^js (unchecked-get self "_net") from (state-payload self "state")))
            (when (identical? "in-call" (unchecked-get self "status")) (attach! self from)))

          :else nil)
        ((unchecked-get self "onRoster") (self-state self) members))))
  js/undefined)

(defn on-channel-open [self peer]
  (when (identical? "in-call" (unchecked-get self "status"))
    (.sendTo ^js (unchecked-get self "_net") peer (state-payload self "state")))
  js/undefined)

(defn on-peer-gone [self peer]
  (drop-member! self peer)
  (.dropPeer ^js (unchecked-get self "_media") peer)
  ((unchecked-get self "onRoster") (self-state self) (unchecked-get self "members"))
  js/undefined)

(defn on-peer-state [self peer state]
  (let [m (.get ^js (unchecked-get self "members") peer)]
    (when-not (identical? m js/undefined)
      (if (identical? "disconnected" state)
        ;; TS `m.staleTimer ??= setTimeout(...)` — NULLISH, so an existing timer
        ;; is never replaced
        (when-not (j/truthy? (unchecked-get m "staleTimer"))
          (unchecked-set m "staleTimer"
                         (js/setTimeout (fn []
                                          (drop-member! self peer)
                                          ((unchecked-get self "onRoster") (self-state self)
                                                                           (unchecked-get self "members"))
                                          js/undefined)
                                        STALE-MS)))
        (when (j/truthy? (unchecked-get m "staleTimer"))
          (js/clearTimeout (unchecked-get m "staleTimer"))
          (unchecked-set m "staleTimer" js/undefined)))
      (when (and (identical? "in-call" (unchecked-get self "status"))
                 (or (identical? "direct" state) (identical? "relayed" state)))
        (attach! self peer))))
  js/undefined)

(defn on-track [self peer stream]
  (let [m (.get ^js (unchecked-get self "members") peer)]
    (when-not (identical? m js/undefined)
      (unchecked-set m "stream" stream)
      ((unchecked-get self "onRoster") (self-state self) (unchecked-get self "members"))))
  js/undefined)

;; ---- internals -------------------------------------------------------------

(defn- attach! [self peer-id]
  (let [local (unchecked-get self "_local")]
    (when (j/truthy? local)
      (.attachMedia ^js (unchecked-get self "_media") peer-id local
                    (j/ordered "maxVideoKbps" VIDEO-KBPS))))
  js/undefined)

(defn- drop-member! [self peer]
  (let [members ^js (unchecked-get self "members")
        m (.get members peer)]
    (when (and (j/truthy? m) (j/truthy? (unchecked-get m "staleTimer")))
      (js/clearTimeout (unchecked-get m "staleTimer")))
    (.delete members peer))
  js/undefined)

(defn- video-count [self]
  (let [n (volatile! (if (j/truthy? (unchecked-get self "camOn")) 1 0))]
    (.forEach ^js (unchecked-get self "members")
              (fn [m _k] (when (j/truthy? (unchecked-get m "video")) (vswap! n inc))))
    @n))

(defn- state-payload [self op]
  ;; FIVE keys, in the TS literal's order
  (j/ordered "kind" "call" "op" op
             "audio" (unchecked-get self "micOn")
             "video" (unchecked-get self "camOn")
             "name" ((unchecked-get self "_myName"))))

(defn- broadcast! [self op]
  (.broadcast ^js (unchecked-get self "_net") (state-payload self op))
  js/undefined)

(defn- wake! [self]
  (-> (js/Promise.resolve nil)
      (.then (fn [_]
               (let [wl (unchecked-get js/navigator "wakeLock")]
                 (js-await [lock (if (j/truthy? wl) (.request ^js wl "screen") (js/Promise.resolve nil))]
                   (do (unchecked-set self "_wakeLock" (if (j/truthy? lock) lock nil))
                       js/undefined)))))
      (.catch (fn [_] nil))))

(defn- recover-tracks!
  "iOS ends tracks under screen lock — re-acquire or degrade honestly."
  [self]
  (let [local (unchecked-get self "_local")]
    (if-not (j/truthy? local)
      (js/Promise.resolve nil)
      (let [dead (.some (js/Array.from (.getTracks ^js local))
                        (fn [track] (identical? "ended" (.-readyState ^js track))))]
        (if-not dead
          (wake! self)
          (-> (js/Promise.resolve nil)
              (.then (fn [_]
                       (let [c (j/ordered "audio" AUDIO-CONSTRAINTS)]
                         (when (j/truthy? (unchecked-get self "camOn"))
                           (unchecked-set c "video" (video-constraints)))
                         (js-await [fresh (.getUserMedia (.-mediaDevices js/navigator) c)]
                           (do
                             (stop-tracks! (unchecked-get self "_local"))
                             (unchecked-set self "_local" fresh)
                             (set! (.-enabled (aget (.getAudioTracks ^js fresh) 0)) (unchecked-get self "micOn"))
                             (doseq [peer-id (array-seq (js/Array.from (.keys ^js (unchecked-get self "members"))))]
                               (attach! self peer-id))
                             js/undefined)))))
              (.catch (fn [_]
                        (unchecked-set self "camOn" false)
                        (broadcast! self "state")
                        nil))
              (.then (fn [_]
                       (wake! self)
                       ((unchecked-get self "onRoster") (self-state self) (unchecked-get self "members"))
                       js/undefined))))))))

;; ---- class surface ---------------------------------------------------------

(let [proto (.-prototype CallManager)]
  (js/Object.defineProperty
   proto "localStream"
   (j/ordered "get" (fn [] (this-as self (local-stream self))) "configurable" true))
  (js/Object.defineProperty
   proto "active"
   (j/ordered "get" (fn [] (this-as self (active? self))) "configurable" true))
  (unchecked-set proto "join" (fn [with-video] (this-as self (join self with-video))))
  (unchecked-set proto "leave" (fn [] (this-as self (leave self))))
  (unchecked-set proto "toggleMic" (fn [] (this-as self (toggle-mic self))))
  (unchecked-set proto "toggleCam" (fn [] (this-as self (toggle-cam self))))
  (unchecked-set proto "self" (fn [] (this-as self (self-state self))))
  (unchecked-set proto "onWire" (fn [from raw] (this-as self (on-wire self from raw))))
  (unchecked-set proto "onChannelOpen" (fn [peer] (this-as self (on-channel-open self peer))))
  (unchecked-set proto "onPeerGone" (fn [peer] (this-as self (on-peer-gone self peer))))
  (unchecked-set proto "onPeerState" (fn [peer state] (this-as self (on-peer-state self peer state))))
  (unchecked-set proto "onTrack" (fn [peer stream] (this-as self (on-track self peer stream))))
  ;; the "private" surface the tests drive (peer-kit's `_name` idiom)
  (unchecked-set proto "_statePayload" (fn [op] (this-as self (state-payload self op)))))

static mirror of HEAD · about · clone: git clone https://git.ardegazu.ro/chat.git