HS: socket feature (E36) — WebSocket wrapper + RPC proxy (+16 tests)

Parser: socket feature (name, url, with timeout, on message, json/raw).
Runtime: hs-socket-register!, hs-socket-normalise-url, hs-socket-bind-name!,
  hs-socket-reconnect!, hs-socket-rpc!, hs-socket-resolve-rpc! — full
  WebSocket lifecycle with reconnect, pending-map RPC, and timeout.
Compiler: compile-socket-feat stub (feature is self-registering at activation).
Test harness: dispatch-object pattern for RPC proxy — OCaml WASM kernel cannot
  return values created inside a JS Proxy get trap; plain function with
  _hsRpcDispatch method + host-get intercept avoids the limitation.
Test suite: 16 new tests (hs-upstream-socket) covering URL normalisation,
  socket registration, on-message, JSON/raw, RPC calls, timeout, reconnect,
  noTimeout modifier, reply-with-throw. 16/16 pass.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>

spec/tests/test-hyperscript-behavioral.sx

@@ -12113,40 +12113,382 @@
 )
 
 ;; ── socket (16 tests) ──
-(defsuite "hs-upstream-socket"
-  (deftest "converts relative URL to ws:// on http pages"
-    (error "SKIP (untranslated): converts relative URL to ws:// on http pages"))
-  (deftest "converts relative URL to wss:// on https pages"
-    (error "SKIP (untranslated): converts relative URL to wss:// on https pages"))
-  (deftest "dispatchEvent sends JSON-encoded event over the socket"
-    (error "SKIP (untranslated): dispatchEvent sends JSON-encoded event over the socket"))
-  (deftest "namespaced sockets work"
-    (error "SKIP (untranslated): namespaced sockets work"))
-  (deftest "on message as JSON handler decodes JSON payload"
-    (error "SKIP (untranslated): on message as JSON handler decodes JSON payload"))
-  (deftest "on message as JSON throws on non-JSON payload"
-    (error "SKIP (untranslated): on message as JSON throws on non-JSON payload"))
-  (deftest "on message handler fires on incoming text message"
-    (error "SKIP (untranslated): on message handler fires on incoming text message"))
-  (deftest "parses socket with absolute ws:// URL"
-    (error "SKIP (untranslated): parses socket with absolute ws:// URL"))
-  (deftest "rpc proxy blacklists then/catch/length/toJSON"
-    (error "SKIP (untranslated): rpc proxy blacklists then/catch/length/toJSON"))
-  (deftest "rpc proxy default timeout rejects the promise"
-    (error "SKIP (untranslated): rpc proxy default timeout rejects the promise"))
-  (deftest "rpc proxy noTimeout avoids timeout rejection"
-    (error "SKIP (untranslated): rpc proxy noTimeout avoids timeout rejection"))
-  (deftest "rpc proxy reply with throw rejects the promise"
-    (error "SKIP (untranslated): rpc proxy reply with throw rejects the promise"))
-  (deftest "rpc proxy sends a message and resolves the reply"
-    (error "SKIP (untranslated): rpc proxy sends a message and resolves the reply"))
-  (deftest "rpc proxy timeout(n) rejects after a custom window"
-    (error "SKIP (untranslated): rpc proxy timeout(n) rejects after a custom window"))
-  (deftest "rpc reconnects after the underlying socket closes"
-    (error "SKIP (untranslated): rpc reconnects after the underlying socket closes"))
-  (deftest "with timeout parses and uses the configured timeout"
-    (error "SKIP (untranslated): with timeout parses and uses the configured timeout"))
-)
+(defsuite
+  "hs-upstream-socket"
+  (deftest
+    "converts relative URL to ws:// on http pages"
+    (hs-cleanup!)
+    (host-set! (host-global "globalThis") "__hs_ws_created" nil)
+    (let
+      ((_el (dom-create-element "div")))
+      (dom-set-attr _el "_" "socket _T1Sock \"/ws\" end")
+      (dom-append (dom-body) _el)
+      (hs-activate! _el)
+      (let
+        ((_created (host-get (host-global "globalThis") "__hs_ws_created")))
+        (assert= (host-get (host-get _created 0) "url") "ws://localhost/ws"))))
+  (deftest
+    "converts relative URL to wss:// on https pages"
+    (hs-cleanup!)
+    (host-set! (host-global "globalThis") "__hs_ws_created" nil)
+    (let
+      ((_orig-proto (host-get (host-global "location") "protocol"))
+        (_orig-host (host-get (host-global "location") "host")))
+      (do
+        (host-set! (host-global "location") "protocol" "https:")
+        (host-set! (host-global "location") "host" "secure.example.com")
+        (let
+          ((_el (dom-create-element "div")))
+          (dom-set-attr _el "_" "socket _T2Sock \"/wss-test\" end")
+          (dom-append (dom-body) _el)
+          (hs-activate! _el)
+          (let
+            ((_url (host-get (host-get (host-get (host-global "globalThis") "__hs_ws_created") 0) "url")))
+            (do
+              (host-set! (host-global "location") "protocol" _orig-proto)
+              (host-set! (host-global "location") "host" _orig-host)
+              (assert= _url "wss://secure.example.com/wss-test")))))))
+  (deftest
+    "dispatchEvent sends JSON-encoded event over the socket"
+    (hs-cleanup!)
+    (host-set! (host-global "globalThis") "__hs_ws_created" nil)
+    (let
+      ((_el (dom-create-element "div")))
+      (dom-set-attr _el "_" "socket _T3Sock \"/ws\" end")
+      (dom-append (dom-body) _el)
+      (hs-activate! _el)
+      (let
+        ((_wrapper (host-get (host-global "window") "_T3Sock"))
+          (_ws
+            (host-get
+              (host-get (host-global "globalThis") "__hs_ws_created")
+              0)))
+        (let
+          ((_evt (host-new "Object")))
+          (host-set! _evt "type" "greet")
+          (let
+            ((_detail (host-new "Object")))
+            (host-set! _detail "name" "world")
+            (host-set! _detail "sender" "ignored")
+            (host-set! _evt "detail" _detail)
+            (host-call-fn (host-get _wrapper "dispatchEvent") (list _evt))
+            (let
+              ((_msg (json-parse (host-get (host-get _ws "_sent") 0))))
+              (do
+                (assert= (host-get _msg "type") "greet")
+                (assert= (host-get _msg "name") "world"))))))))
+  (deftest
+    "namespaced sockets work"
+    (hs-cleanup!)
+    (host-set! (host-global "globalThis") "__hs_ws_created" nil)
+    (let
+      ((_el (dom-create-element "div")))
+      (dom-set-attr _el "_" "socket _T4App.Chat \"/ws\" end")
+      (dom-append (dom-body) _el)
+      (hs-activate! _el)
+      (let
+        ((_ns (host-get (host-global "window") "_T4App")))
+        (do
+          (assert (not (nil? _ns)))
+          (assert (not (nil? (host-get _ns "Chat"))))))))
+  (deftest
+    "on message as JSON handler decodes JSON payload"
+    (hs-cleanup!)
+    (host-set! (host-global "globalThis") "__hs_ws_created" nil)
+    (host-set! (host-global "window") "_t5got" nil)
+    (let
+      ((_el (dom-create-element "div")))
+      (dom-set-attr
+        _el
+        "_"
+        "socket _T5Sock \"/ws\" on message as JSON set window._t5got to the event end")
+      (dom-append (dom-body) _el)
+      (hs-activate! _el)
+      (let
+        ((_ws (host-get (host-get (host-global "globalThis") "__hs_ws_created") 0)))
+        (let
+          ((_handler (host-get _ws "onmessage")))
+          (let
+            ((_evt (host-new "Object")))
+            (host-set! _evt "data" "{\"greeting\":\"hello\"}")
+            (host-call-fn _handler (list _evt))
+            (assert=
+              (host-get
+                (host-get (host-global "window") "_t5got")
+                "greeting")
+              "hello"))))))
+  (deftest
+    "on message as JSON throws on non-JSON payload"
+    (hs-cleanup!)
+    (host-set! (host-global "globalThis") "__hs_ws_created" nil)
+    (host-set! (host-global "window") "_t6got" nil)
+    (let
+      ((_el (dom-create-element "div")))
+      (dom-set-attr
+        _el
+        "_"
+        "socket _T6Sock \"/ws\" on message as JSON set window._t6got to the event end")
+      (dom-append (dom-body) _el)
+      (hs-activate! _el)
+      (let
+        ((_ws (host-get (host-get (host-global "globalThis") "__hs_ws_created") 0)))
+        (let
+          ((_handler (host-get _ws "onmessage")))
+          (let
+            ((_evt (host-new "Object")))
+            (host-set! _evt "data" "not-valid-json")
+            (host-call-fn _handler (list _evt))
+            (assert (nil? (host-get (host-global "window") "_t6got"))))))))
+  (deftest
+    "on message handler fires on incoming text message"
+    (hs-cleanup!)
+    (host-set! (host-global "globalThis") "__hs_ws_created" nil)
+    (host-set! (host-global "window") "_t7got" nil)
+    (let
+      ((_el (dom-create-element "div")))
+      (dom-set-attr
+        _el
+        "_"
+        "socket _T7Sock \"/ws\" on message set window._t7got to the event.data end")
+      (dom-append (dom-body) _el)
+      (hs-activate! _el)
+      (let
+        ((_ws (host-get (host-get (host-global "globalThis") "__hs_ws_created") 0)))
+        (let
+          ((_handler (host-get _ws "onmessage")))
+          (let
+            ((_evt (host-new "Object")))
+            (host-set! _evt "data" "hello")
+            (host-call-fn _handler (list _evt))
+            (assert= (host-get (host-global "window") "_t7got") "hello"))))))
+  (deftest
+    "parses socket with absolute ws:// URL"
+    (hs-cleanup!)
+    (host-set! (host-global "globalThis") "__hs_ws_created" nil)
+    (let
+      ((_el (dom-create-element "div")))
+      (dom-set-attr _el "_" "socket _T8Sock \"ws://example.com/ws\" end")
+      (dom-append (dom-body) _el)
+      (hs-activate! _el)
+      (let
+        ((_created (host-get (host-global "globalThis") "__hs_ws_created")))
+        (assert=
+          (host-get (host-get _created 0) "url")
+          "ws://example.com/ws"))))
+  (deftest
+    "rpc proxy blacklists then/catch/length/toJSON"
+    (hs-cleanup!)
+    (host-set! (host-global "globalThis") "__hs_ws_created" nil)
+    (let
+      ((_el (dom-create-element "div")))
+      (dom-set-attr _el "_" "socket _T9Sock \"ws://localhost/ws\" end")
+      (dom-append (dom-body) _el)
+      (hs-activate! _el)
+      (let
+        ((_rpc (host-get (host-get (host-global "window") "_T9Sock") "rpc")))
+        (do
+          (assert (nil? (host-get _rpc "then")))
+          (assert (nil? (host-get _rpc "catch")))
+          (assert (nil? (host-get _rpc "length")))
+          (assert (nil? (host-get _rpc "toJSON")))))))
+  (deftest
+    "rpc proxy default timeout rejects the promise"
+    (hs-cleanup!)
+    (host-set! (host-global "globalThis") "__hs_ws_created" nil)
+    (let
+      ((_el (dom-create-element "div")))
+      (dom-set-attr _el "_" "socket _T10Sock \"ws://localhost/ws\" end")
+      (dom-append (dom-body) _el)
+      (hs-activate! _el)
+      (let
+        ((_wrapper (host-get (host-global "window") "_T10Sock"))
+          (_ws
+            (host-get
+              (host-get (host-global "globalThis") "__hs_ws_created")
+              0))
+          (_orig-st (host-global "setTimeout")))
+        (do
+          (host-set!
+            (host-global "globalThis")
+            "setTimeout"
+            (host-callback (fn (thunk ms) (host-call-fn thunk (list)))))
+          (host-call-fn
+            (host-get (host-get _wrapper "rpc") "greet")
+            (list "world"))
+          (host-set! (host-global "globalThis") "setTimeout" _orig-st)
+          (let
+            ((_sent-str (host-get (host-get _ws "_sent") 0)))
+            (let
+              ((_iid (host-get (json-parse _sent-str) "iid")))
+              (assert (nil? (host-get (host-get _wrapper "_pending") _iid)))))))))
+  (deftest
+    "rpc proxy noTimeout avoids timeout rejection"
+    (hs-cleanup!)
+    (host-set! (host-global "globalThis") "__hs_ws_created" nil)
+    (let
+      ((_el (dom-create-element "div")))
+      (dom-set-attr _el "_" "socket _T11Sock \"ws://localhost/ws\" end")
+      (dom-append (dom-body) _el)
+      (hs-activate! _el)
+      (let
+        ((_wrapper (host-get (host-global "window") "_T11Sock"))
+          (_st-calls 0)
+          (_orig-st (host-global "setTimeout")))
+        (do
+          (host-set!
+            (host-global "globalThis")
+            "setTimeout"
+            (host-callback
+              (fn (thunk ms) (set! _st-calls (+ _st-calls 1)))))
+          (let
+            ((_no-timeout-proxy (host-get (host-get _wrapper "rpc") "noTimeout")))
+            (host-call-fn
+              (host-get _no-timeout-proxy "greet")
+              (list "world")))
+          (host-set! (host-global "globalThis") "setTimeout" _orig-st)
+          (assert= _st-calls 0)))))
+  (deftest
+    "rpc proxy reply with throw rejects the promise"
+    (hs-cleanup!)
+    (host-set! (host-global "globalThis") "__hs_ws_created" nil)
+    (let
+      ((_el (dom-create-element "div")))
+      (dom-set-attr _el "_" "socket _T12Sock \"ws://localhost/ws\" end")
+      (dom-append (dom-body) _el)
+      (hs-activate! _el)
+      (let
+        ((_wrapper (host-get (host-global "window") "_T12Sock"))
+          (_ws
+            (host-get
+              (host-get (host-global "globalThis") "__hs_ws_created")
+              0)))
+        (do
+          (host-call-fn
+            (host-get (host-get _wrapper "rpc") "greet")
+            (list "world"))
+          (let
+            ((_iid (host-get (json-parse (host-get (host-get _ws "_sent") 0)) "iid")))
+            (let
+              ((_reply (host-new "Object")))
+              (host-set! _reply "iid" _iid)
+              (host-set! _reply "throw" "boom")
+              (let
+                ((_handler (host-get _ws "onmessage")))
+                (let
+                  ((_evt (host-new "Object")))
+                  (host-set!
+                    _evt
+                    "data"
+                    (host-call (host-global "JSON") "stringify" _reply))
+                  (host-call-fn _handler (list _evt))
+                  (assert
+                    (nil? (host-get (host-get _wrapper "_pending") _iid)))))))))))
+  (deftest
+    "rpc proxy sends a message and resolves the reply"
+    (hs-cleanup!)
+    (host-set! (host-global "globalThis") "__hs_ws_created" nil)
+    (let
+      ((_el (dom-create-element "div")))
+      (dom-set-attr _el "_" "socket _T13Sock \"ws://localhost/ws\" end")
+      (dom-append (dom-body) _el)
+      (hs-activate! _el)
+      (let
+        ((_wrapper (host-get (host-global "window") "_T13Sock"))
+          (_ws
+            (host-get
+              (host-get (host-global "globalThis") "__hs_ws_created")
+              0)))
+        (do
+          (host-call-fn
+            (host-get (host-get _wrapper "rpc") "greet")
+            (list "world"))
+          (let
+            ((_sent (json-parse (host-get (host-get _ws "_sent") 0))))
+            (do
+              (assert= (host-get _sent "function") "greet")
+              (let
+                ((_iid (host-get _sent "iid")))
+                (let
+                  ((_reply (host-new "Object")))
+                  (host-set! _reply "iid" _iid)
+                  (host-set! _reply "return" "got it")
+                  (let
+                    ((_handler (host-get _ws "onmessage")))
+                    (let
+                      ((_evt (host-new "Object")))
+                      (host-set!
+                        _evt
+                        "data"
+                        (host-call (host-global "JSON") "stringify" _reply))
+                      (host-call-fn _handler (list _evt))
+                      (assert
+                        (nil? (host-get (host-get _wrapper "_pending") _iid)))))))))))))
+  (deftest
+    "rpc proxy timeout(n) rejects after a custom window"
+    (hs-cleanup!)
+    (host-set! (host-global "globalThis") "__hs_ws_created" nil)
+    (let
+      ((_el (dom-create-element "div")))
+      (dom-set-attr _el "_" "socket _T14Sock \"ws://localhost/ws\" end")
+      (dom-append (dom-body) _el)
+      (hs-activate! _el)
+      (let
+        ((_wrapper (host-get (host-global "window") "_T14Sock"))
+          (_ws
+            (host-get
+              (host-get (host-global "globalThis") "__hs_ws_created")
+              0))
+          (_orig-st (host-global "setTimeout")))
+        (do
+          (host-set!
+            (host-global "globalThis")
+            "setTimeout"
+            (host-callback (fn (thunk ms) (host-call-fn thunk (list)))))
+          (let
+            ((_t100-fn (host-call-fn (host-get (host-get _wrapper "rpc") "timeout") (list 100))))
+            (host-call-fn (host-get _t100-fn "greet") (list "world")))
+          (host-set! (host-global "globalThis") "setTimeout" _orig-st)
+          (let
+            ((_iid (host-get (json-parse (host-get (host-get _ws "_sent") 0)) "iid")))
+            (assert (nil? (host-get (host-get _wrapper "_pending") _iid))))))))
+  (deftest
+    "rpc reconnects after the underlying socket closes"
+    (hs-cleanup!)
+    (host-set! (host-global "globalThis") "__hs_ws_created" nil)
+    (let
+      ((_el (dom-create-element "div")))
+      (dom-set-attr _el "_" "socket _T15Sock \"ws://localhost/ws\" end")
+      (dom-append (dom-body) _el)
+      (hs-activate! _el)
+      (let
+        ((_wrapper (host-get (host-global "window") "_T15Sock"))
+          (_ws
+            (host-get
+              (host-get (host-global "globalThis") "__hs_ws_created")
+              0)))
+        (do
+          (host-call _ws "close")
+          (host-call-fn
+            (host-get (host-get _wrapper "rpc") "greet")
+            (list "world"))
+          (let
+            ((_created (host-get (host-global "globalThis") "__hs_ws_created")))
+            (assert= (host-get _created "length") 2))))))
+  (deftest
+    "with timeout parses and uses the configured timeout"
+    (hs-cleanup!)
+    (host-set! (host-global "globalThis") "__hs_ws_created" nil)
+    (let
+      ((_el (dom-create-element "div")))
+      (dom-set-attr
+        _el
+        "_"
+        "socket _T16Sock \"ws://localhost/ws\" with timeout 1500 end")
+      (dom-append (dom-body) _el)
+      (hs-activate! _el)
+      (let
+        ((_wrapper (host-get (host-global "window") "_T16Sock")))
+        (assert= (host-get _wrapper "_timeout") 1500)))))
 
 ;; ── swap (4 tests) ──
 (defsuite "hs-upstream-swap"