rooms-kit / src / ardegazu / rooms / node / env.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
;; ported-from: src/node/env.ts @ v1.0.0
;;
;; Node environment shims for the suite's origin-gated managed relay.
;;
;; The relay, TURN-credential and mailbox-mint endpoints admit requests by
;; browser Origin. Node sends none by default, so both the WebSocket dial and the
;; credential fetches would be refused. These installers patch the globals once,
;; scoped by hostname, so every module works unchanged.
(ns ardegazu.rooms.node.env
  (:require ["ws" :refer (WebSocket)]
            ["node:fs" :refer (mkdirSync readFileSync writeFileSync)]
            ["node:path" :refer (dirname)]
            [ardegazu.rooms.js :as j]
            ;; `super` is a special form inside defclass's constructor, not a
            ;; var — shadow rewrites the call site; do not :refer it.
            [shadow.cljs.modern :refer (defclass)]))

;; Hosts that get the Origin header (the suite's signaling infrastructure).
(def ^:private DEFAULT-HOSTS #js [#"\.ardegazu\.ro$" #"\.ap2p\.ro$"])

;; `selfPeerIds` was published from here by v1.0.0's node/env.ts and still is (see
;; scripts/gen-subpaths.mjs), but it is pure `globalThis` and runs in a browser
;; too, so its one definition lives in lib/net alongside the dial guard that
;; reads it.

(defn- host-matches [host allow]
  (.some ^js allow (fn [re] (.test ^js re host))))

;; The origin/host allowlist the patched WebSocket reads.
;;
;; Deliberate difference from the TypeScript original: it declared the subclass
;; INSIDE installOriginWebSocket, so every call installed a brand-new class. A
;; CLJS `defclass` is a top-level form, so the class is declared once here and
;; reads the current origin from module state. Behaviour is identical (a second
;; install rebinds the origin); only the class identity is now stable across
;; calls, which is strictly better — repeated installs cannot stack subclasses.
(defonce ^:private ws-config (atom nil))

(defclass OriginWebSocket
  (extends WebSocket)
  (constructor [this url protocols]
    (let [cfg @ws-config
          host (.-hostname (js/URL. url))
          opts (when (and (some? cfg) (host-matches host (:hosts cfg)))
                 (j/ordered "origin" (:origin cfg)))]
      (super url protocols (if (some? opts) opts js/undefined)))
    ;; the libp2p transport reads/writes browser-flavored fields; ws supports
    ;; both, but binaryType must be one the transport expects
    (unchecked-set this "binaryType" "arraybuffer")))

(defn install-origin-web-socket
  "Replace globalThis.WebSocket with a ws-backed class that sends the Origin
   header when dialing suite hosts. @libp2p/websockets@9 dials the *global*
   WebSocket with no options, so subclassing is the only injection point."
  ([origin] (install-origin-web-socket origin DEFAULT-HOSTS))
  ([origin hosts]
   (reset! ws-config {:origin origin :hosts hosts})
   (unchecked-set js/globalThis "WebSocket" OriginWebSocket)
   js/undefined))

(defn install-origin-fetch
  "Wrap globalThis.fetch to add the Origin header on suite-host requests."
  ([origin] (install-origin-fetch origin DEFAULT-HOSTS))
  ([origin hosts]
   (let [base (unchecked-get js/globalThis "fetch")]
     (unchecked-set
      js/globalThis "fetch"
      (fn [input init]
        (let [url (if (or (identical? "string" (js* "typeof ~{}" input))
                          (instance? js/URL input))
                    (js/URL. input)
                    (js/URL. (unchecked-get input "url")))]
          (if-not (host-matches (.-hostname url) hosts)
            (base input init)
            ;; TS `init?.headers ?? (input instanceof Request ? input.headers
            ;; : undefined)` — NULLISH, so an empty-but-present headers value is
            ;; used as given
            (let [headers (js/Headers.
                           (let [h (when (some? init) (unchecked-get init "headers"))]
                             (if-not (or (nil? h) (identical? h js/undefined))
                               h
                               (if (instance? js/Request input)
                                 (unchecked-get input "headers")
                                 js/undefined))))]
              (when-not (.has headers "origin") (.set headers "origin" origin))
              (base input (js/Object.assign (js-obj) init (j/ordered "headers" headers)))))))))
   js/undefined))

(defonce ^:private installed (atom nil))

(defn install-origin
  "Install both shims for the given origin (e.g. \"https://chat.ardegazu.ro\" —
   must be on the app's allowlist). Idempotent; call once at process start,
   before any libp2p node or credential fetch is created."
  ([origin] (install-origin origin DEFAULT-HOSTS))
  ([origin hosts]
   (when-not (identical? @installed origin)
     (when (some? @installed)
       (throw (js/Error. (str "origin shims already installed for " @installed))))
     (reset! installed origin)
     (install-origin-web-socket origin hosts)
     (install-origin-fetch origin hosts))
   js/undefined))

(defn- create-file-storage [file]
  ;; one-slot array as the mutable cell, so the closures below share it
  (let [cell (array (js-obj))
        _ (when (some? file)
            (try (aset cell 0 (js/JSON.parse (readFileSync file "utf8")))
                 (catch :default _ nil))) ; fresh store
        flush (fn []
                (when (some? file)
                  (try
                    (mkdirSync (dirname file) (j/ordered "recursive" true))
                    (writeFileSync file (js/JSON.stringify (aget cell 0)))
                    (catch :default _ nil))) ; best-effort persistence
                js/undefined)]
    (j/ordered
     "getItem" (fn [k] (if (js-in k (aget cell 0)) (unchecked-get (aget cell 0) k) nil))
     "setItem" (fn [k v] (unchecked-set (aget cell 0) k (js/String v)) (flush) js/undefined)
     "removeItem" (fn [k] (js-delete (aget cell 0) k) (flush) js/undefined))))

(defn install-browser-globals
  "Minimal browser globals for modules written against the DOM that only touch it
   shallowly: `window.setTimeout`, a visibility check that should always read
   \"visible\" in a headless peer, and `localStorage` for small persisted sets.
   Storage is file-backed — pass a path under your state directory."
  ([] (install-browser-globals nil))
  ([storage-file]
   (let [g js/globalThis]
     ;; TS `g.window ??= {…}` / `g.document ??= {…}` — nullish, not falsy
     (when (or (nil? (unchecked-get g "window")) (identical? js/undefined (unchecked-get g "window")))
       (unchecked-set g "window"
                      (j/ordered "setTimeout" js/setTimeout
                                 "clearTimeout" js/clearTimeout
                                 "setInterval" js/setInterval
                                 "clearInterval" js/clearInterval
                                 "addEventListener" (fn [] js/undefined)
                                 "removeEventListener" (fn [] js/undefined))))
     (when (or (nil? (unchecked-get g "document")) (identical? js/undefined (unchecked-get g "document")))
       (unchecked-set g "document"
                      (j/ordered "visibilityState" "visible"
                                 "addEventListener" (fn [] js/undefined)
                                 "removeEventListener" (fn [] js/undefined))))
     ;; TS `if (!("localStorage" in g) || g.localStorage === undefined)` — the
     ;; `in` operator, so an inherited/getter-backed global counts as present
     (when (or (not (js-in "localStorage" g))
               (identical? js/undefined (unchecked-get g "localStorage")))
       (unchecked-set g "localStorage"
                      (create-file-storage (if (some? storage-file) storage-file nil)))))
   js/undefined))

static mirror of HEAD · about · clone: git clone https://git.ardegazu.ro/rooms-kit.git