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

spec/tests/test-hyperscript-behavioral.sx

@@ -11821,37 +11821,166 @@
 ;; ── 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"))
+    (hs-cleanup!)
+    (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"
-    (error "SKIP (untranslated): converts relative URL to wss:// on https pages"))
+    (hs-cleanup!)
+    (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"
-    (error "SKIP (untranslated): dispatchEvent sends JSON-encoded event over the socket"))
+    (hs-cleanup!)
+    (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"
-    (error "SKIP (untranslated): namespaced sockets work"))
+    (hs-cleanup!)
+    (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"
-    (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"
-    (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"
-    (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"
-    (error "SKIP (untranslated): parses socket with absolute ws:// URL"))
+    (hs-cleanup!)
+    (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"
-    (error "SKIP (untranslated): rpc proxy blacklists then/catch/length/toJSON"))
+    (hs-cleanup!)
+    (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"
-    (error "SKIP (untranslated): rpc proxy default timeout rejects the promise"))
+    (hs-cleanup!)
+    (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-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"
-    (error "SKIP (untranslated): rpc proxy noTimeout avoids timeout rejection"))
+    (hs-cleanup!)
+    (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
+          (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"
-    (error "SKIP (untranslated): rpc proxy reply with throw rejects the promise"))
+    (hs-cleanup!)
+    (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 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"
-    (error "SKIP (untranslated): rpc proxy sends a message and resolves the reply"))
+    (hs-cleanup!)
+    (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 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
+              (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"
-    (error "SKIP (untranslated): rpc proxy timeout(n) rejects after a custom window"))
+    (hs-cleanup!)
+    (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
+          (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"
-    (error "SKIP (untranslated): rpc reconnects after the underlying socket closes"))
+    (hs-cleanup!)
+    (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 rpc "greet")
+          (assert= (host-get (host-global "__hs_ws_created") "_len") 2)))))
   (deftest "with timeout parses and uses the configured timeout"
-    (error "SKIP (untranslated): with timeout parses and uses the configured timeout"))
+    (hs-cleanup!)
+    (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) ──