hs: port loops/hs WebSocket runtime + test suite (replaces arch's underscore-prefixed API)
Adopts loops/hs's cleaner WebSocket API on top of arch's hyperscript: - Runtime: replace 5 arch socket functions (hs-try-json-parse, hs-socket-normalise-url, hs-socket-bind-name!, hs-socket-resolve-rpc!, hs-socket-register!) with loops/hs's versions. Wrapper fields now use external-style names (url, timeout, pending, handler, json?, closedFlag, dispatchEvent) instead of internal-style underscores (_url, _timeout, _pending, _hsSetupSocket). - Tests: replace arch's 257-line hs-upstream-socket suite (which probed _pending, _hsSetupSocket etc.) with loops/hs's 162-line suite that checks the new field names. Both suites cover the same 16 E36 behavioral cases. Parser/compiler unchanged: both branches emit (hs-socket-register! name-path url timeout handler json?) so the call signature is compatible with either runtime. Arch's parse-socket-feat / emit-socket are preserved. Local hs test.sh: 23/25 (the 2 failures are pre-existing hide/show cmd compiler issues, not socket-related). Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -3242,97 +3242,112 @@
|
||||
|
||||
(define hs-token-op? (fn (tok) (dict-get tok :op)))
|
||||
|
||||
;; ── WebSocket / socket feature ───────────────────────────────────
|
||||
|
||||
(define
|
||||
hs-try-json-parse
|
||||
(fn (data) (if (string? data) (guard (_e nil) (json-parse data)) nil)))
|
||||
|
||||
(define
|
||||
hs-socket-normalise-url
|
||||
(fn
|
||||
(url)
|
||||
(if
|
||||
(or (starts-with? url "ws://") (starts-with? url "wss://"))
|
||||
url
|
||||
(let
|
||||
((proto (host-get (host-global "location") "protocol"))
|
||||
(host-str (host-get (host-global "location") "host")))
|
||||
(let
|
||||
((scheme (if (= proto "https:") "wss://" "ws://")))
|
||||
(str scheme host-str url))))))
|
||||
|
||||
(define
|
||||
hs-socket-bind-name!
|
||||
(fn
|
||||
(name-path wrapper)
|
||||
(let
|
||||
((win (host-global "window")))
|
||||
(if
|
||||
(= (len name-path) 1)
|
||||
(host-set! win (first name-path) wrapper)
|
||||
(do
|
||||
(when
|
||||
(nil? (host-get win (first name-path)))
|
||||
(host-set! win (first name-path) (host-new "Object")))
|
||||
(host-set!
|
||||
(host-get win (first name-path))
|
||||
(nth name-path 1)
|
||||
wrapper))))))
|
||||
(fn (s) (host-call (host-global "JSON") "parse" s)))
|
||||
|
||||
(define
|
||||
hs-socket-resolve-rpc!
|
||||
(fn
|
||||
(wrapper data)
|
||||
(wrapper msg)
|
||||
(let
|
||||
((iid (host-get data "iid")))
|
||||
(when
|
||||
(not (nil? iid))
|
||||
(let
|
||||
((pending (host-get wrapper "_pending")))
|
||||
(when
|
||||
(not (nil? pending))
|
||||
(let
|
||||
((entry (host-get pending iid)))
|
||||
(when
|
||||
(not (nil? entry))
|
||||
(host-set! pending iid nil)
|
||||
(if
|
||||
(not (nil? (host-get data "throw")))
|
||||
(host-call-fn
|
||||
(host-get entry "reject")
|
||||
(list (host-get data "throw")))
|
||||
(host-call-fn
|
||||
(host-get entry "resolve")
|
||||
(list (host-get data "return"))))))))))))
|
||||
((pending (host-get wrapper "pending")) (iid (host-get msg "iid")))
|
||||
(let
|
||||
((resolver (host-get pending iid)))
|
||||
(when
|
||||
(not (nil? resolver))
|
||||
(if
|
||||
(not (nil? (host-get msg "return")))
|
||||
(host-call resolver "resolve" (host-get msg "return"))
|
||||
(host-call resolver "reject" (host-get msg "throw")))
|
||||
(host-set! pending iid nil))))))
|
||||
|
||||
(define
|
||||
hs-socket-register!
|
||||
(fn
|
||||
(name-path url timeout on-message-handler json?)
|
||||
(name-path url timeout-ms handler json?)
|
||||
(let
|
||||
((norm-url (hs-socket-normalise-url url)))
|
||||
((ws-url (cond ((or (starts-with? url "ws://") (starts-with? url "wss://")) url) (true (let ((proto (host-get (host-global "location") "protocol")) (h (host-get (host-global "location") "host"))) (str (if (= proto "https:") "wss:" "ws:") "//" h url))))))
|
||||
(let
|
||||
((wrapper (host-new "Object")))
|
||||
(do
|
||||
(host-set! wrapper "_url" norm-url)
|
||||
(host-set! wrapper "_timeout" (if (nil? timeout) 0 timeout))
|
||||
(host-set! wrapper "_pending" (host-new "Object"))
|
||||
(host-set! wrapper "_closed" false)
|
||||
((ws (host-new "WebSocket" ws-url)))
|
||||
(let
|
||||
((wrapper (host-new "Object")))
|
||||
(host-set! wrapper "raw" ws)
|
||||
(host-set! wrapper "url" ws-url)
|
||||
(host-set! wrapper "timeout" timeout-ms)
|
||||
(host-set! wrapper "pending" (host-new "Object"))
|
||||
(host-set! wrapper "handler" handler)
|
||||
(host-set! wrapper "json?" json?)
|
||||
(host-set! wrapper "closed?" false)
|
||||
(host-set! wrapper "closedFlag" nil)
|
||||
(let
|
||||
((ws (host-new "WebSocket" norm-url)))
|
||||
(do
|
||||
(host-set! wrapper "_ws" ws)
|
||||
(let
|
||||
((msg-handler (host-callback (fn (evt) (do (let ((parsed (hs-try-json-parse (host-get evt "data")))) (when (and (not (nil? parsed)) (not (nil? (host-get parsed "iid")))) (hs-socket-resolve-rpc! wrapper parsed))) (when (not (nil? on-message-handler)) (if json? (let ((data (hs-try-json-parse (host-get evt "data")))) (when (not (nil? data)) (on-message-handler data))) (on-message-handler evt))))))))
|
||||
(do
|
||||
(host-set! ws "onmessage" msg-handler)
|
||||
(host-set! wrapper "_onmessage_handler" msg-handler)
|
||||
(host-set!
|
||||
ws
|
||||
"onclose"
|
||||
(host-callback
|
||||
(fn (e) (host-set! wrapper "_closed" true))))
|
||||
(host-call-fn
|
||||
(host-global "_hsSetupSocket")
|
||||
(list wrapper))
|
||||
(hs-socket-bind-name! name-path wrapper)
|
||||
wrapper)))))))))
|
||||
((proxy-factory (host-global "_hs_make_rpc_proxy")))
|
||||
(when
|
||||
proxy-factory
|
||||
(host-set!
|
||||
wrapper
|
||||
"rpc"
|
||||
(host-call proxy-factory "call" nil wrapper))))
|
||||
(host-set!
|
||||
ws
|
||||
"onmessage"
|
||||
(host-callback
|
||||
(fn
|
||||
(event)
|
||||
(let
|
||||
((data (host-get event "data")))
|
||||
(let
|
||||
((parsed (hs-try-json-parse data)))
|
||||
(cond
|
||||
((and (not (nil? parsed)) (not (nil? (host-get parsed "iid"))))
|
||||
(hs-socket-resolve-rpc! wrapper parsed))
|
||||
((not (nil? handler))
|
||||
(if
|
||||
json?
|
||||
(if
|
||||
(not (nil? parsed))
|
||||
(handler parsed)
|
||||
(error "Received non-JSON message"))
|
||||
(handler event)))))))))
|
||||
(host-call
|
||||
ws
|
||||
"addEventListener"
|
||||
"close"
|
||||
(host-callback
|
||||
(fn
|
||||
(evt)
|
||||
(host-set! wrapper "closedFlag" "1"))))
|
||||
(host-set!
|
||||
wrapper
|
||||
"dispatchEvent"
|
||||
(host-callback
|
||||
(fn
|
||||
(evt)
|
||||
(let
|
||||
((payload (host-new "Object")))
|
||||
(host-set! payload "type" (host-get evt "type"))
|
||||
(host-call
|
||||
(host-get wrapper "raw")
|
||||
"send"
|
||||
(host-call
|
||||
(host-global "JSON")
|
||||
"stringify"
|
||||
payload))))))
|
||||
(define
|
||||
bind-path!
|
||||
(fn
|
||||
(obj path)
|
||||
(if
|
||||
(= (len path) 1)
|
||||
(host-set! obj (first path) wrapper)
|
||||
(let
|
||||
((key (first path)) (rest-path (rest path)))
|
||||
(let
|
||||
((next (or (host-get obj key) (host-new "Object"))))
|
||||
(host-set! obj key next)
|
||||
(bind-path! next rest-path))))))
|
||||
(bind-path! (host-global "window") name-path)
|
||||
wrapper)))))
|
||||
|
||||
|
||||
@@ -12396,266 +12396,171 @@
|
||||
))
|
||||
)
|
||||
|
||||
|
||||
;; ── socket (16 tests) ──
|
||||
(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")))
|
||||
)
|
||||
(host-set! (host-global "window") "__hs_ws_created" (list))
|
||||
(eval-hs "socket RelSocket /my-ws end")
|
||||
(let ((sock (host-get (host-global "__hs_ws_created") 0)))
|
||||
(assert= (host-get sock "url") "ws://localhost/my-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"))))))
|
||||
)
|
||||
(host-set! (host-global "window") "__hs_ws_created" (list))
|
||||
(host-set! (host-global "location") "protocol" "https:")
|
||||
(eval-hs "socket RelSocket /my-ws end")
|
||||
(host-set! (host-global "location") "protocol" "http:")
|
||||
(let ((sock (host-get (host-global "__hs_ws_created") 0)))
|
||||
(assert= (host-get sock "url") "wss://localhost/my-ws")))
|
||||
(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")))))))
|
||||
)
|
||||
(eval-hs "socket DispatchSocket ws://localhost/ws end")
|
||||
(let ((wrapper (host-get (host-global "window") "DispatchSocket")))
|
||||
(let ((ws (host-get wrapper "raw"))
|
||||
(evt (host-new "Object")))
|
||||
(do
|
||||
(host-set! evt "type" "foo-event")
|
||||
(host-call wrapper "dispatchEvent" evt)
|
||||
(assert (not (nil? (host-get (host-get ws "_sent") 0))))
|
||||
(let ((parsed (hs-try-json-parse (host-get (host-get ws "_sent") 0))))
|
||||
(assert= (host-get parsed "type") "foo-event"))))))
|
||||
(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")))))))
|
||||
)
|
||||
(eval-hs "socket MyApp.chat ws://localhost/ws end")
|
||||
(let ((my-app (host-get (host-global "window") "MyApp")))
|
||||
(let ((chat (host-get my-app "chat")))
|
||||
(assert (not (nil? (host-get chat "raw")))))))
|
||||
(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")))))
|
||||
)
|
||||
(eval-hs "socket JsonSocket ws://localhost/ws on message as JSON set window.socketFiredJson to true end")
|
||||
(let ((sock (host-get (host-global "window") "JsonSocket")))
|
||||
(let ((ws (host-get sock "raw")))
|
||||
(do
|
||||
(host-call ws "onmessage" {:data "{\"name\":\"Alice\"}"}))
|
||||
(assert= (host-get (host-global "window") "socketFiredJson") true))))
|
||||
(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")))))))
|
||||
)
|
||||
(eval-hs "socket StrictJsonSocket ws://localhost/ws on message as JSON set window.strictFired to true end")
|
||||
(let ((sock (host-get (host-global "window") "StrictJsonSocket")))
|
||||
(let ((ws (host-get sock "raw")))
|
||||
(do
|
||||
(host-call ws "onmessage" {:data "not-json"})
|
||||
(assert (nil? (host-get (host-global "window") "strictFired")))))))
|
||||
(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")))))
|
||||
)
|
||||
(eval-hs "socket TextSocket ws://localhost/ws on message set window.socketFired to true end")
|
||||
(let ((sock (host-get (host-global "window") "TextSocket")))
|
||||
(let ((ws (host-get sock "raw")))
|
||||
(do
|
||||
(host-call ws "onmessage" {:data "hello socket"})
|
||||
(assert= (host-get (host-global "window") "socketFired") true)))))
|
||||
(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")))
|
||||
)
|
||||
(host-set! (host-global "window") "__hs_ws_created" (list))
|
||||
(eval-hs "socket MySocket ws://localhost:1234/ws end")
|
||||
(let ((sock (host-get (host-global "__hs_ws_created") 0)))
|
||||
(assert= (host-get sock "url") "ws://localhost:1234/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"))))))
|
||||
)
|
||||
(eval-hs "socket RpcSocket ws://localhost/ws end")
|
||||
(let ((rpc (host-get (host-get (host-global "window") "RpcSocket") "rpc")))
|
||||
(do
|
||||
(assert (not (= (host-typeof (host-get rpc "then")) "function")))
|
||||
(assert (not (= (host-typeof (host-get rpc "catch")) "function")))
|
||||
(assert (not (= (host-typeof (host-get rpc "length")) "function")))
|
||||
(assert (not (= (host-typeof (host-get rpc "toJSON")) "function"))))
|
||||
(assert (not (nil? rpc)))))
|
||||
(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")))
|
||||
(eval-hs "socket DefTOSocket ws://localhost/ws with timeout 50 end")
|
||||
(let ((wrapper (host-get (host-global "window") "DefTOSocket")))
|
||||
(let ((rpc (host-get wrapper "rpc")))
|
||||
(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))))))))
|
||||
)
|
||||
(host-call rpc "neverReplies")
|
||||
(let ((keys-before (host-call (host-global "Object") "keys" (host-get wrapper "pending"))))
|
||||
(assert= (host-get keys-before "length") 1))
|
||||
(host-call (host-global "__hsFlushTimers") "call")
|
||||
(let ((keys-after (host-call (host-global "Object") "keys" (host-get wrapper "pending"))))
|
||||
(assert= (host-get keys-after "length") 0))))))
|
||||
(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")))
|
||||
(eval-hs "socket NoTOSocket ws://localhost/ws with timeout 20 end")
|
||||
(let ((wrapper (host-get (host-global "window") "NoTOSocket")))
|
||||
(let ((rpc (host-get wrapper "rpc")))
|
||||
(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))))
|
||||
)
|
||||
(let ((no-timeout (host-call rpc "noTimeout")))
|
||||
(host-call no-timeout "slowCall" "x"))
|
||||
(host-call (host-global "__hsFlushTimers") "call")
|
||||
(let ((keys-after (host-call (host-global "Object") "keys" (host-get wrapper "pending"))))
|
||||
(assert= (host-get keys-after "length") 1))))))
|
||||
(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)))
|
||||
(eval-hs "socket RpcThrowSocket ws://localhost/ws end")
|
||||
(let ((wrapper (host-get (host-global "window") "RpcThrowSocket")))
|
||||
(let ((ws (host-get wrapper "raw"))
|
||||
(rpc (host-get wrapper "rpc")))
|
||||
(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))))))))))
|
||||
)
|
||||
(host-call rpc "greet" "world")
|
||||
(let ((iid (host-get (hs-try-json-parse (host-get (host-get ws "_sent") 0)) "iid")))
|
||||
(let ((resp (host-new "Object")))
|
||||
(do
|
||||
(host-set! resp "iid" iid)
|
||||
(host-set! resp "throw" "SomeError")
|
||||
(host-call ws "onmessage"
|
||||
{:data (host-call (host-global "JSON") "stringify" resp)})
|
||||
(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)))
|
||||
(eval-hs "socket RpcSendSocket ws://localhost/ws end")
|
||||
(let ((wrapper (host-get (host-global "window") "RpcSendSocket")))
|
||||
(let ((ws (host-get wrapper "raw"))
|
||||
(rpc (host-get wrapper "rpc")))
|
||||
(do
|
||||
(host-call-fn (host-get (host-get _wrapper "rpc") "greet") (list "world"))
|
||||
(let ((_sent (json-parse (host-get (host-get _ws "_sent") 0))))
|
||||
(host-call rpc "greet" "world")
|
||||
(assert (not (nil? (host-get ws "_sent"))))
|
||||
(let ((iid (host-get (hs-try-json-parse (host-get (host-get ws "_sent") 0)) "iid")))
|
||||
(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))))))))))))
|
||||
)
|
||||
(let ((resp (host-new "Object")))
|
||||
(do
|
||||
(host-set! resp "iid" iid)
|
||||
(host-set! resp "return" "hello")
|
||||
(host-call ws "onmessage"
|
||||
{:data (host-call (host-global "JSON") "stringify" resp)})))
|
||||
(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")))
|
||||
(eval-hs "socket CustomTOSocket ws://localhost/ws with timeout 60000 end")
|
||||
(let ((wrapper (host-get (host-global "window") "CustomTOSocket")))
|
||||
(let ((rpc (host-get wrapper "rpc")))
|
||||
(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)))))))
|
||||
)
|
||||
(let ((timeout-fn (host-call rpc "timeout"))
|
||||
(custom-proxy (host-call-fn timeout-fn (list 50))))
|
||||
(host-call custom-proxy "willTimeOut"))
|
||||
(let ((keys-before (host-call (host-global "Object") "keys" (host-get wrapper "pending"))))
|
||||
(assert= (host-get keys-before "length") 1))
|
||||
(host-call (host-global "__hsFlushTimers") "call")
|
||||
(let ((keys-after (host-call (host-global "Object") "keys" (host-get wrapper "pending"))))
|
||||
(assert= (host-get keys-after "length") 0))))))
|
||||
(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)))
|
||||
(host-set! (host-global "window") "__hs_ws_created" nil)
|
||||
(eval-hs "socket ReconnSocket ws://localhost/ws end")
|
||||
(let ((wrapper (host-get (host-global "window") "ReconnSocket")))
|
||||
(let ((ws (host-get wrapper "raw"))
|
||||
(rpc (host-get wrapper "rpc")))
|
||||
(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)))))
|
||||
)
|
||||
(host-call ws "close")
|
||||
(host-call rpc "greet")
|
||||
(assert= (host-get (host-global "__hs_ws_created") "_len") 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)))
|
||||
)
|
||||
(eval-hs "socket TimedSocket ws://localhost/ws with timeout 1500 end")
|
||||
(let ((sock (host-get (host-global "window") "TimedSocket")))
|
||||
(do
|
||||
(assert (not (nil? sock)))
|
||||
(assert (not (nil? (host-get sock "rpc")))))))
|
||||
)
|
||||
|
||||
;; ── swap (4 tests) ──
|
||||
(defsuite "hs-upstream-swap"
|
||||
(deftest "can swap a variable with a property"
|
||||
|
||||
Reference in New Issue
Block a user