From e2ed73055f51275d0ceeab9139f37fb18eb1f498 Mon Sep 17 00:00:00 2001
From: Camden Dixie O'Brien <cdo@wip.sh>
Date: Wed, 4 Mar 2026 01:08:54 +0000
Subject: [PATCH] Write Guile module for Firefox interaction with Marionette

---
 e2e-tests/marionette.scm | 136 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 136 insertions(+)
 create mode 100644 e2e-tests/marionette.scm

diff --git a/e2e-tests/marionette.scm b/e2e-tests/marionette.scm
new file mode 100644
index 0000000..506265c
--- /dev/null
+++ b/e2e-tests/marionette.scm
@@ -0,0 +1,136 @@
+(define-module (wipforth marionette)
+  #:export (with-marionette
+			start-firefox
+			close-firefox
+			client-setup
+			client-teardown
+			navigate
+			input-line
+			get-display))
+
+(use-modules
+ (json)
+ (scheme base)
+ (srfi srfi-9))
+
+(define-syntax-rule (with-marionette client body ...)
+  (let ((client #f) (pid #f))
+	(dynamic-wind
+	  (lambda ()
+		(set! pid (start-firefox))
+		(set! client (client-setup)))
+	  (lambda () body ...)
+	  (lambda ()
+		(when client (client-teardown client))
+		(when pid (close-firefox pid))))))
+
+(define (start-firefox)
+  (let* ((i/o (pipe))
+		 (pid (spawn "firefox" '("firefox" "--marionette" "--headless")
+					 #:output (cdr i/o)
+					 #:error (cdr i/o))))
+	(let loop ((line (read-line (car i/o))))
+	  (cond
+	   ((string-contains line "Listening on port") #nil)
+	   ((eof-object? line) (format #t "EOF when starting firefox~%"))
+	   (#t (loop (read-line (car i/o))))))
+	(close-port (car i/o))
+	(close-port (cdr i/o))
+	pid))
+
+(define (close-firefox pid)
+  (kill pid SIGINT)
+  (waitpid pid)
+  *unspecified*)
+
+(define-record-type client
+  (make-client socket msg-num)
+  client?
+  (socket client-socket)
+  (msg-num client-msg-num client-msg-num-set!))
+
+(define (client-msg-num-1+! client)
+  (client-msg-num-set! client (1+ (client-msg-num client))))
+
+(define (open-socket host port)
+  (let ((sock (socket PF_INET SOCK_STREAM 0))
+		(addr (inet-pton AF_INET host)))
+	(connect sock AF_INET addr port)
+	sock))
+
+(define (handle-start-msg client)
+  (let* ((msg (read-msg (client-socket client)))
+		 (protocol (assoc-ref msg "marionetteProtocol")))
+	(unless (= 3 protocol)
+	  (format #t "Unsupported protocol: ~a~%" protocol))))
+
+(define* (client-setup #:key (host "127.0.0.1") (port 2828))
+  (let ((client (make-client (open-socket host port) 0)))
+	(handle-start-msg client)
+	(create-session client)
+	client))
+
+(define (client-teardown client)
+  (close (client-socket client)))
+
+(define (add-digit val digit)
+  (+ (* val 10) (- digit 48)))
+
+(define (read-msg-len sock)
+  (let loop ((len 0) (byte (read-u8 sock)))
+	(if (eq? byte 58)
+		len
+		(loop (add-digit len byte)
+			  (read-u8 sock)))))
+
+(define (read-msg sock)
+  (let ((len (read-msg-len sock)))
+	(json-string->scm (utf8->string (read-bytevector len sock)))))
+
+(define (send-msg sock msg)
+  (let* ((payload (string->utf8 (scm->json-string msg)))
+		 (len (bytevector-length payload)))
+	(write-bytevector (string->utf8 (number->string len)) sock)
+	(write-u8 58 sock)
+	(write-bytevector payload sock)))
+
+(define (send-command client command params)
+  (send-msg (client-socket client)
+			(vector 0 (client-msg-num client) command params))
+  (client-msg-num-1+! client)
+  (let* ((response (read-msg (client-socket client)))
+		 (error (vector-ref response 2))
+		 (result (vector-ref response 3)))
+	(unless (eq? 'null error)
+	  (format #t "Error: ~a~%" (assoc-ref error "message")))
+	(assoc-ref result "value")))
+
+(define (create-session client)
+  (send-command client "WebDriver:NewSession" '())
+  *unspecified*)
+
+(define (navigate client url)
+  (send-command client "WebDriver:Navigate" `(("url" . ,url)))
+  *unspecified*)
+
+(define (find-element client selector)
+  (assoc-ref
+   (send-command client "WebDriver:FindElement"
+				 `(("using" . "css selector")
+				   ("value" . ,selector)))
+   "element-6066-11e4-a52e-4f735466cecf"))
+
+(define (send-keys client text)
+  (let ((id (find-element client "body")))
+	(send-command client "WebDriver:ElementSendKeys"
+				  `(("id" . ,id) ("text" . ,text)))))
+
+(define (get-element-text client selector)
+  (let ((id (find-element client selector)))
+	(send-command client "WebDriver:GetElementText" `(("id" . ,id)))))
+
+(define (input-line client text)
+  (send-keys client (string-append text "\ue007")))
+
+(define (get-display client)
+  (get-element-text client "#output"))