(define-module (e2e 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"))