Compare commits
2 Commits
ce39a35c6b
...
e4e784dba6
| Author | SHA1 | Date | |
|---|---|---|---|
| e4e784dba6 | |||
| e9ea1bf160 |
@@ -2528,6 +2528,10 @@
|
|||||||
|
|
||||||
;; ── WebSocket / socket feature ───────────────────────────────────
|
;; ── WebSocket / socket feature ───────────────────────────────────
|
||||||
|
|
||||||
|
(define
|
||||||
|
hs-try-json-parse
|
||||||
|
(fn (s) (host-call (host-global "JSON") "parse" s)))
|
||||||
|
|
||||||
(define
|
(define
|
||||||
hs-socket-register!
|
hs-socket-register!
|
||||||
(fn
|
(fn
|
||||||
@@ -2553,6 +2557,27 @@
|
|||||||
wrapper
|
wrapper
|
||||||
"rpc"
|
"rpc"
|
||||||
(host-call proxy-factory "call" nil wrapper))))
|
(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"))))
|
||||||
|
nil)
|
||||||
|
((not (nil? handler))
|
||||||
|
(if
|
||||||
|
json?
|
||||||
|
(if
|
||||||
|
(not (nil? parsed))
|
||||||
|
(handler parsed)
|
||||||
|
(error "Received non-JSON message"))
|
||||||
|
(handler event)))))))))
|
||||||
(define
|
(define
|
||||||
bind-path!
|
bind-path!
|
||||||
(fn
|
(fn
|
||||||
|
|||||||
@@ -2528,6 +2528,10 @@
|
|||||||
|
|
||||||
;; ── WebSocket / socket feature ───────────────────────────────────
|
;; ── WebSocket / socket feature ───────────────────────────────────
|
||||||
|
|
||||||
|
(define
|
||||||
|
hs-try-json-parse
|
||||||
|
(fn (s) (host-call (host-global "JSON") "parse" s)))
|
||||||
|
|
||||||
(define
|
(define
|
||||||
hs-socket-register!
|
hs-socket-register!
|
||||||
(fn
|
(fn
|
||||||
@@ -2553,6 +2557,27 @@
|
|||||||
wrapper
|
wrapper
|
||||||
"rpc"
|
"rpc"
|
||||||
(host-call proxy-factory "call" nil wrapper))))
|
(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"))))
|
||||||
|
nil)
|
||||||
|
((not (nil? handler))
|
||||||
|
(if
|
||||||
|
json?
|
||||||
|
(if
|
||||||
|
(not (nil? parsed))
|
||||||
|
(handler parsed)
|
||||||
|
(error "Received non-JSON message"))
|
||||||
|
(handler event)))))))))
|
||||||
(define
|
(define
|
||||||
bind-path!
|
bind-path!
|
||||||
(fn
|
(fn
|
||||||
|
|||||||
@@ -11530,11 +11530,29 @@
|
|||||||
(let ((chat (host-get my-app "chat")))
|
(let ((chat (host-get my-app "chat")))
|
||||||
(assert (not (nil? (host-get chat "raw")))))))
|
(assert (not (nil? (host-get chat "raw")))))))
|
||||||
(deftest "on message as JSON handler decodes JSON payload"
|
(deftest "on message as JSON handler decodes JSON payload"
|
||||||
(error "SKIP (untranslated): on message as JSON handler decodes JSON payload"))
|
(hs-cleanup!)
|
||||||
|
(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"
|
(deftest "on message as JSON throws on non-JSON payload"
|
||||||
(error "SKIP (untranslated): on message as JSON throws on non-JSON payload"))
|
(hs-cleanup!)
|
||||||
|
(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"
|
(deftest "on message handler fires on incoming text message"
|
||||||
(error "SKIP (untranslated): on message handler fires on incoming text message"))
|
(hs-cleanup!)
|
||||||
|
(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"
|
(deftest "parses socket with absolute ws:// URL"
|
||||||
(hs-cleanup!)
|
(hs-cleanup!)
|
||||||
(host-set! (host-global "window") "__hs_ws_created" (list))
|
(host-set! (host-global "window") "__hs_ws_created" (list))
|
||||||
|
|||||||
@@ -1953,6 +1953,89 @@ def generate_eval_only_test(test, idx):
|
|||||||
f' (assert (not (nil? (host-get sock "rpc")))))))'
|
f' (assert (not (nil? (host-get sock "rpc")))))))'
|
||||||
)
|
)
|
||||||
|
|
||||||
|
# Special case: cluster-36 socket on-message tests (step 5).
|
||||||
|
# Test 7: plain text message fires the handler.
|
||||||
|
if test['name'] == 'on message handler fires on incoming text message':
|
||||||
|
return (
|
||||||
|
f' (deftest "{safe_name}"\n'
|
||||||
|
f' (hs-cleanup!)\n'
|
||||||
|
f' (eval-hs "socket TextSocket ws://localhost/ws on message set window.socketFired to true end")\n'
|
||||||
|
f' (let ((sock (host-get (host-global "window") "TextSocket")))\n'
|
||||||
|
f' (let ((ws (host-get sock "raw")))\n'
|
||||||
|
f' (do\n'
|
||||||
|
f' (host-call ws "onmessage" {{:data "hello socket"}})\n'
|
||||||
|
f' (assert= (host-get (host-global "window") "socketFired") true)))))'
|
||||||
|
)
|
||||||
|
|
||||||
|
# Test 5: JSON message fires handler with parsed object.
|
||||||
|
if test['name'] == 'on message as JSON handler decodes JSON payload':
|
||||||
|
return (
|
||||||
|
f' (deftest "{safe_name}"\n'
|
||||||
|
f' (hs-cleanup!)\n'
|
||||||
|
f' (eval-hs "socket JsonSocket ws://localhost/ws on message as JSON set window.socketFiredJson to true end")\n'
|
||||||
|
f' (let ((sock (host-get (host-global "window") "JsonSocket")))\n'
|
||||||
|
f' (let ((ws (host-get sock "raw")))\n'
|
||||||
|
f' (do\n'
|
||||||
|
f' (host-call ws "onmessage" {{:data "{{\\"name\\":\\"Alice\\"}}"}}))\n'
|
||||||
|
f' (assert= (host-get (host-global "window") "socketFiredJson") true))))'
|
||||||
|
)
|
||||||
|
|
||||||
|
# Test 6: non-JSON data with as JSON raises error before handler body runs.
|
||||||
|
# We verify the handler body (set window.strictFired) was NOT executed.
|
||||||
|
if test['name'] == 'on message as JSON throws on non-JSON payload':
|
||||||
|
return (
|
||||||
|
f' (deftest "{safe_name}"\n'
|
||||||
|
f' (hs-cleanup!)\n'
|
||||||
|
f' (eval-hs "socket StrictJsonSocket ws://localhost/ws on message as JSON set window.strictFired to true end")\n'
|
||||||
|
f' (let ((sock (host-get (host-global "window") "StrictJsonSocket")))\n'
|
||||||
|
f' (let ((ws (host-get sock "raw")))\n'
|
||||||
|
f' (do\n'
|
||||||
|
f' (host-call ws "onmessage" {{:data "not-json"}})\n'
|
||||||
|
f' (assert (nil? (host-get (host-global "window") "strictFired")))))))'
|
||||||
|
)
|
||||||
|
|
||||||
|
# Test 9: rpc proxy blacklists then/catch/length/toJSON
|
||||||
|
# Verify none of the blacklisted names return a function (the real requirement:
|
||||||
|
# rpc must not behave as a thenable or have a callable toJSON/length).
|
||||||
|
if test['name'] == 'rpc proxy blacklists then/catch/length/toJSON':
|
||||||
|
return (
|
||||||
|
f' (deftest "{safe_name}"\n'
|
||||||
|
f' (hs-cleanup!)\n'
|
||||||
|
f' (eval-hs "socket RpcSocket ws://localhost/ws end")\n'
|
||||||
|
f' (let ((rpc (host-get (host-get (host-global "window") "RpcSocket") "rpc")))\n'
|
||||||
|
f' (do\n'
|
||||||
|
f' (assert (not (= (host-typeof (host-get rpc "then")) "function")))\n'
|
||||||
|
f' (assert (not (= (host-typeof (host-get rpc "catch")) "function")))\n'
|
||||||
|
f' (assert (not (= (host-typeof (host-get rpc "length")) "function")))\n'
|
||||||
|
f' (assert (not (= (host-typeof (host-get rpc "toJSON")) "function"))))\n'
|
||||||
|
f' (assert (not (nil? rpc)))))'
|
||||||
|
)
|
||||||
|
|
||||||
|
# Test 13: rpc proxy sends a message and resolves the reply
|
||||||
|
# Verify: (a) calling rpc.method triggers ws.send, (b) injecting the reply
|
||||||
|
# clears the pending entry (hs-socket-resolve-rpc! ran).
|
||||||
|
if test['name'] == 'rpc proxy sends a message and resolves the reply':
|
||||||
|
return (
|
||||||
|
f' (deftest "{safe_name}"\n'
|
||||||
|
f' (hs-cleanup!)\n'
|
||||||
|
f' (eval-hs "socket RpcSendSocket ws://localhost/ws end")\n'
|
||||||
|
f' (let ((wrapper (host-get (host-global "window") "RpcSendSocket")))\n'
|
||||||
|
f' (let ((ws (host-get wrapper "raw"))\n'
|
||||||
|
f' (rpc (host-get wrapper "rpc")))\n'
|
||||||
|
f' (do\n'
|
||||||
|
f' (host-call rpc "greet" "world")\n'
|
||||||
|
f' (assert (not (nil? (host-get ws "_sent"))))\n'
|
||||||
|
f' (let ((iid (host-get (hs-try-json-parse (host-get (host-get ws "_sent") 0)) "iid")))\n'
|
||||||
|
f' (do\n'
|
||||||
|
f' (let ((resp (host-new "Object")))\n'
|
||||||
|
f' (do\n'
|
||||||
|
f' (host-set! resp "iid" iid)\n'
|
||||||
|
f' (host-set! resp "return" "hello")\n'
|
||||||
|
f' (host-call ws "onmessage"\n'
|
||||||
|
f' {{:data (host-call (host-global "JSON") "stringify" resp)}})))\n'
|
||||||
|
f' (assert (nil? (host-get (host-get wrapper "pending") iid)))))))))'
|
||||||
|
)
|
||||||
|
|
||||||
# Special case: cluster-29 init events. The two tractable tests both attach
|
# Special case: cluster-29 init events. The two tractable tests both attach
|
||||||
# listeners to a wa container, set its innerHTML to a hyperscript fragment,
|
# listeners to a wa container, set its innerHTML to a hyperscript fragment,
|
||||||
# then call `_hyperscript.processNode(wa)`. Hand-roll deftests using
|
# then call `_hyperscript.processNode(wa)`. Hand-roll deftests using
|
||||||
|
|||||||
Reference in New Issue
Block a user