HS: socket feature (E36) — WebSocket wrapper + RPC proxy (+16 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
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>
This commit is contained in:
@@ -479,6 +479,278 @@ MANUAL_TEST_BODIES = {
|
||||
' (assert= (len (host-get _r "children")) 1)',
|
||||
' (assert= (host-get (first (host-get _r "children")) "tagName") "P")))',
|
||||
],
|
||||
# socket E36: relative URL normalised to ws:// (http page)
|
||||
"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")))',
|
||||
],
|
||||
# socket E36: relative URL normalised to wss:// (https page)
|
||||
"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"))))))',
|
||||
],
|
||||
# socket E36: dispatchEvent JSON-encodes and sends the event
|
||||
"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")))))))',
|
||||
],
|
||||
# socket E36: dotted name creates nested namespace objects
|
||||
"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")))))))',
|
||||
],
|
||||
# socket E36: on message as JSON — handler receives parsed JSON
|
||||
"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")))))',
|
||||
],
|
||||
# socket E36: on message as JSON with non-JSON data — handler not called
|
||||
"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")))))))',
|
||||
],
|
||||
# socket E36: plain on message fires handler with raw event
|
||||
"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")))))',
|
||||
],
|
||||
# socket E36: absolute ws:// URL passes through unchanged
|
||||
"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")))',
|
||||
],
|
||||
# socket E36: rpc proxy blacklists then/catch/length/toJSON
|
||||
"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"))))))',
|
||||
],
|
||||
# socket E36: rpc default timeout (0ms) fires setTimeout → pending cleared
|
||||
"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))))))))',
|
||||
],
|
||||
# socket E36: noTimeout proxy skips setTimeout entirely
|
||||
"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))))',
|
||||
],
|
||||
# socket E36: onmessage with {iid,throw} clears pending entry (reject called)
|
||||
"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))))))))))',
|
||||
],
|
||||
# socket E36: rpc call sends {iid,function,args}; onmessage reply clears pending
|
||||
"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))))))))))))',
|
||||
],
|
||||
# socket E36: .timeout(n) proxy fires setTimeout with that delay → pending cleared
|
||||
"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)))))))',
|
||||
],
|
||||
# socket E36: after ws.close(), next RPC lazily creates new WebSocket
|
||||
"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)))))',
|
||||
],
|
||||
# socket E36: with timeout N sets wrapper._timeout to N
|
||||
"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)))',
|
||||
],
|
||||
}
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user