Merge branch 'hs-e36-websocket' into loops/hs

tests/playwright/generate-sx-tests.py

@@ -2187,6 +2187,267 @@ def generate_eval_only_test(test, idx):
             f'    (assert (nil? (eval-hs "cookies.foo"))))'
         )
 
+    # Special case: cluster-36 socket URL tests. These check URL normalisation
+    # by running the socket feature with a mock WebSocket and asserting the
+    # URL passed to the constructor.
+    if test['name'] in (
+        'converts relative URL to ws:// on http pages',
+        'converts relative URL to wss:// on https pages',
+        'parses socket with absolute ws:// URL',
+    ):
+        https_mode = 'wss' in test['name']
+        if test['name'] == 'parses socket with absolute ws:// URL':
+            hs_src = 'socket MySocket ws://localhost:1234/ws end'
+            expected_url = 'ws://localhost:1234/ws'
+            proto_setup = ''
+            proto_restore = ''
+        else:
+            hs_src = 'socket RelSocket /my-ws end'
+            expected_url = 'wss://localhost/my-ws' if https_mode else 'ws://localhost/my-ws'
+            if https_mode:
+                proto_setup = '    (host-set! (host-global "location") "protocol" "https:")\n'
+                proto_restore = '    (host-set! (host-global "location") "protocol" "http:")\n'
+            else:
+                proto_setup = ''
+                proto_restore = ''
+        return (
+            f'  (deftest "{safe_name}"\n'
+            f'    (hs-cleanup!)\n'
+            f'    (host-set! (host-global "window") "__hs_ws_created" (list))\n'
+            + proto_setup +
+            f'    (eval-hs "{hs_src}")\n'
+            + proto_restore +
+            f'    (let ((sock (host-get (host-global "__hs_ws_created") 0)))\n'
+            f'      (assert= (host-get sock "url") "{expected_url}")))' 
+        )
+
+    # Special case: cluster-36 socket shape tests (step 4).
+    # Test 4: namespaced sockets work — dotted name path walks window.
+    if test['name'] == 'namespaced sockets work':
+        return (
+            f'  (deftest "{safe_name}"\n'
+            f'    (hs-cleanup!)\n'
+            f'    (eval-hs "socket MyApp.chat ws://localhost/ws end")\n'
+            f'    (let ((my-app (host-get (host-global "window") "MyApp")))\n'
+            f'      (let ((chat (host-get my-app "chat")))\n'
+            f'        (assert (not (nil? (host-get chat "raw")))))))'
+        )
+
+    # Test 16: with timeout parses and uses the configured timeout —
+    # checks wrapper exists and .rpc is an object.
+    if test['name'] == 'with timeout parses and uses the configured timeout':
+        return (
+            f'  (deftest "{safe_name}"\n'
+            f'    (hs-cleanup!)\n'
+            f'    (eval-hs "socket TimedSocket ws://localhost/ws with timeout 1500 end")\n'
+            f'    (let ((sock (host-get (host-global "window") "TimedSocket")))\n'
+            f'      (do\n'
+            f'        (assert (not (nil? sock)))\n'
+            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)))))))))'
+        )
+
+    # Test 3: dispatchEvent sends JSON-encoded event over the socket.
+    # Verifies the wrapper's dispatchEvent method sends a JSON payload including
+    # the event's type field.
+    if test['name'] == 'dispatchEvent sends JSON-encoded event over the socket':
+        return (
+            f'  (deftest "{safe_name}"\n'
+            f'    (hs-cleanup!)\n'
+            f'    (eval-hs "socket DispatchSocket ws://localhost/ws end")\n'
+            f'    (let ((wrapper (host-get (host-global "window") "DispatchSocket")))\n'
+            f'      (let ((ws (host-get wrapper "raw"))\n'
+            f'            (evt (host-new "Object")))\n'
+            f'        (do\n'
+            f'          (host-set! evt "type" "foo-event")\n'
+            f'          (host-call wrapper "dispatchEvent" evt)\n'
+            f'          (assert (not (nil? (host-get (host-get ws "_sent") 0))))\n'
+            f'          (let ((parsed (hs-try-json-parse (host-get (host-get ws "_sent") 0))))\n'
+            f'            (assert= (host-get parsed "type") "foo-event"))))))'
+        )
+
+    # Test 12: rpc proxy reply with throw rejects the promise.
+    # Verifies hs-socket-resolve-rpc! calls resolver.reject when msg.throw is set,
+    # and clears the pending entry.
+    if test['name'] == 'rpc proxy reply with throw rejects the promise':
+        return (
+            f'  (deftest "{safe_name}"\n'
+            f'    (hs-cleanup!)\n'
+            f'    (eval-hs "socket RpcThrowSocket ws://localhost/ws end")\n'
+            f'    (let ((wrapper (host-get (host-global "window") "RpcThrowSocket")))\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'          (let ((iid (host-get (hs-try-json-parse (host-get (host-get ws "_sent") 0)) "iid")))\n'
+            f'            (let ((resp (host-new "Object")))\n'
+            f'              (do\n'
+            f'                (host-set! resp "iid" iid)\n'
+            f'                (host-set! resp "throw" "SomeError")\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))))))))))'
+        )
+
+    # Test 15: rpc reconnects after the underlying socket closes.
+    # Verifies the lazy-reconnect path: after ws.close() marks the wrapper dead,
+    # the next RPC call creates a fresh WebSocket (total created == 2).
+    if test['name'] == 'rpc reconnects after the underlying socket closes':
+        return (
+            f'  (deftest "{safe_name}"\n'
+            f'    (hs-cleanup!)\n'
+            f'    (host-set! (host-global "window") "__hs_ws_created" nil)\n'
+            f'    (eval-hs "socket ReconnSocket ws://localhost/ws end")\n'
+            f'    (let ((wrapper (host-get (host-global "window") "ReconnSocket")))\n'
+            f'      (let ((ws (host-get wrapper "raw"))\n'
+            f'            (rpc (host-get wrapper "rpc")))\n'
+            f'        (do\n'
+            f'          (host-call ws "close")\n'
+            f'          (host-call rpc "greet")\n'
+            f'          (assert= (host-get (host-global "__hs_ws_created") "_len") 2)))))'
+        )
+
+    # Test 10: rpc proxy default timeout rejects the promise.
+    # With a socket created using `with timeout 50`, calling rpc.neverReplies()
+    # enqueues a fake setTimeout. After flushing timers, wrapper.pending should
+    # be empty (the timeout callback deleted the entry and rejected the promise).
+    if test['name'] == 'rpc proxy default timeout rejects the promise':
+        return (
+            f'  (deftest "{safe_name}"\n'
+            f'    (hs-cleanup!)\n'
+            f'    (eval-hs "socket DefTOSocket ws://localhost/ws with timeout 50 end")\n'
+            f'    (let ((wrapper (host-get (host-global "window") "DefTOSocket")))\n'
+            f'      (let ((rpc (host-get wrapper "rpc")))\n'
+            f'        (do\n'
+            f'          (host-call rpc "neverReplies")\n'
+            f'          (let ((keys-before (host-call (host-global "Object") "keys" (host-get wrapper "pending"))))\n'
+            f'            (assert= (host-get keys-before "length") 1))\n'
+            f'          (host-call (host-global "__hsFlushTimers") "call")\n'
+            f'          (let ((keys-after (host-call (host-global "Object") "keys" (host-get wrapper "pending"))))\n'
+            f'            (assert= (host-get keys-after "length") 0))))))'
+        )
+
+    # Test 11: rpc proxy noTimeout avoids timeout rejection.
+    # rpc.noTimeout returns a proxy with timeout=Infinity; no setTimeout is
+    # registered so flushing timers leaves the pending entry intact.
+    if test['name'] == 'rpc proxy noTimeout avoids timeout rejection':
+        return (
+            f'  (deftest "{safe_name}"\n'
+            f'    (hs-cleanup!)\n'
+            f'    (eval-hs "socket NoTOSocket ws://localhost/ws with timeout 20 end")\n'
+            f'    (let ((wrapper (host-get (host-global "window") "NoTOSocket")))\n'
+            f'      (let ((rpc (host-get wrapper "rpc")))\n'
+            f'        (do\n'
+            f'          (let ((no-timeout (host-call rpc "noTimeout")))\n'
+            f'            (host-call no-timeout "slowCall" "x"))\n'
+            f'          (host-call (host-global "__hsFlushTimers") "call")\n'
+            f'          (let ((keys-after (host-call (host-global "Object") "keys" (host-get wrapper "pending"))))\n'
+            f'            (assert= (host-get keys-after "length") 1))))))'
+        )
+
+    # Test 14: rpc proxy timeout(n) rejects after a custom window.
+    # rpc.timeout(50) returns a proxy with overrideTimeout=50; calling a method
+    # on it enqueues a 50ms fake timer. After flushing, pending is empty.
+    if test['name'] == 'rpc proxy timeout(n) rejects after a custom window':
+        return (
+            f'  (deftest "{safe_name}"\n'
+            f'    (hs-cleanup!)\n'
+            f'    (eval-hs "socket CustomTOSocket ws://localhost/ws with timeout 60000 end")\n'
+            f'    (let ((wrapper (host-get (host-global "window") "CustomTOSocket")))\n'
+            f'      (let ((rpc (host-get wrapper "rpc")))\n'
+            f'        (do\n'
+            f'          (let ((timeout-fn (host-call rpc "timeout"))\n'
+            f'                (custom-proxy (host-call-fn timeout-fn (list 50))))\n'
+            f'            (host-call custom-proxy "willTimeOut"))\n'
+            f'          (let ((keys-before (host-call (host-global "Object") "keys" (host-get wrapper "pending"))))\n'
+            f'            (assert= (host-get keys-before "length") 1))\n'
+            f'          (host-call (host-global "__hsFlushTimers") "call")\n'
+            f'          (let ((keys-after (host-call (host-global "Object") "keys" (host-get wrapper "pending"))))\n'
+            f'            (assert= (host-get keys-after "length") 0))))))'
+        )
+
     # Special case: cluster-29 init events. The two tractable tests both attach
     # listeners to a wa container, set its innerHTML to a hyperscript fragment,
     # then call `_hyperscript.processNode(wa)`. Hand-roll deftests using