Chicken/raft
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions
raft/webdriver-impl.scm
Daniel Ziltener 68c4194793
First release 
FossilOrigin-Name: bd39977c82cb9f2e943b2944ad4443e12748b7f854bb2de2c2d27ee99cd4fc01
2023-11-09 01:21:50 +01:00

489 lines
21 KiB
Scheme
Raw Blame History

;; [[file:webdriver.org::*Dependencies][Dependencies:4]]
(import r7rs
(chicken base)
(chicken string)
(chicken process)
(chicken gc)
srfi-34 ;;Exception Handling
srfi-35 ;;Exception Types
base64 ;;decoding screenshot data
http-client ;;API interaction
intarweb ;;Supporting HTTP functionality
uri-common ;;Supporting HTTP functionality
coops ;;Object system
alist-lib ;;Handling alists from JSON objects
medea ;;JSON handling
)
;; Dependencies:4 ends here
;; Error Conditions
;; #+name: wd-exception
;; [[file:webdriver.org::wd-exception][wd-exception]]
(define-condition-type &wd-exception &error wd-exception?
(stacktrace wd-stacktrace)
(data wd-data))
;; wd-exception ends here
;; #+name: conditions
;; [[file:webdriver.org::conditions][conditions]]
(define-condition-type &detached-shadow-root &wd-exception detached-shadow-root?)
(define-condition-type &element-click-intercepted &wd-exception element-click-intercepted?)
(define-condition-type &element-not-interactable &wd-exception element-not-interactable?)
(define-condition-type &insecure-certificate &wd-exception insecure-certificate?)
(define-condition-type &invalid-argument &wd-exception invalid-argument?)
(define-condition-type &invalid-cookie-domain &wd-exception invalid-cookie-domain?)
(define-condition-type &invalid-element-state &wd-exception invalid-element-state?)
(define-condition-type &invalid-selector &wd-exception invalid-selector?)
(define-condition-type &invalid-session-id &wd-exception invalid-session-id?)
(define-condition-type &javascript-error &wd-exception javascript-error?)
(define-condition-type &move-target-out-of-bounds &wd-exception move-target-out-of-bounds?)
(define-condition-type &no-such-alert &wd-exception no-such-alert?)
(define-condition-type &no-such-cookie &wd-exception no-such-cookie?)
(define-condition-type &no-such-element &wd-exception no-such-element?)
(define-condition-type &no-such-frame &wd-exception no-such-frame?)
(define-condition-type &no-such-shadow-root &wd-exception no-such-shadow-root?)
(define-condition-type &no-such-window &wd-exception no-such-window?)
(define-condition-type &script-timeout &wd-exception script-timeout?)
(define-condition-type &session-not-created &wd-exception session-not-created?)
(define-condition-type &stale-element-reference &wd-exception stale-element-reference?)
(define-condition-type &timeout &wd-exception timeout?)
(define-condition-type &unable-to-capture-screen &wd-exception unable-to-capture-screen?)
(define-condition-type &unable-to-set-cookie &wd-exception unable-to-set-cookie?)
(define-condition-type &unexpected-alert-open &wd-exception unexpected-alert-open?)
(define-condition-type &unknown-command &wd-exception unknown-command?)
(define-condition-type &unknown-error &wd-exception unknown-error?)
(define-condition-type &unknown-method &wd-exception unknown-method?)
(define-condition-type &unsupported-operation &wd-exception unsupported-operation?)
(define (wd-throw data)
(case (alist-ref data 'error)
(("detached shadow root") (raise (make-condition &detached-shadow-root (alist-ref data 'stacktrace) data)))
(("element click intercepted") (raise (make-condition &element-click-intercepted (alist-ref data 'stacktrace) data)))
(("element not interactable") (raise (make-condition &element-not-interactable (alist-ref data 'stacktrace) data)))
(("insecure certificate") (raise (make-condition &insecure-certificate (alist-ref data 'stacktrace) data)))
(("invalid argument") (raise (make-condition &invalid-argument (alist-ref data 'stacktrace) data)))
(("invalid cookie domain") (raise (make-condition &invalid-cookie-domain (alist-ref data 'stacktrace) data)))
(("invalid element state") (raise (make-condition &invalid-element-state (alist-ref data 'stacktrace) data)))
(("invalid selector") (raise (make-condition &invalid-selector (alist-ref data 'stacktrace) data)))
(("invalid session id") (raise (make-condition &invalid-session-id (alist-ref data 'stacktrace) data)))
(("javascript error") (raise (make-condition &javascript-error (alist-ref data 'stacktrace) data)))
(("move target out of bounds") (raise (make-condition &move-target-out-of-bounds (alist-ref data 'stacktrace) data)))
(("no such alert") (raise (make-condition &no-such-alert (alist-ref data 'stacktrace) data)))
(("no such cookie") (raise (make-condition &no-such-cookie (alist-ref data 'stacktrace) data)))
(("no such element") (raise (make-condition &no-such-element (alist-ref data 'stacktrace) data)))
(("no such frame") (raise (make-condition &no-such-frame (alist-ref data 'stacktrace) data)))
(("no such shadow root") (raise (make-condition &no-such-shadow-root (alist-ref data 'stacktrace) data)))
(("no such window") (raise (make-condition &no-such-window (alist-ref data 'stacktrace) data)))
(("script timeout") (raise (make-condition &script-timeout (alist-ref data 'stacktrace) data)))
(("session not created") (raise (make-condition &session-not-created (alist-ref data 'stacktrace) data)))
(("stale element reference") (raise (make-condition &stale-element-reference (alist-ref data 'stacktrace) data)))
(("timeout") (raise (make-condition &timeout (alist-ref data 'stacktrace) data)))
(("unable to capture screen") (raise (make-condition &unable-to-capture-screen (alist-ref data 'stacktrace) data)))
(("unable to set cookie") (raise (make-condition &unable-to-set-cookie (alist-ref data 'stacktrace) data)))
(("unexpected alert open") (raise (make-condition &unexpected-alert-open (alist-ref data 'stacktrace) data)))
(("unknown command") (raise (make-condition &unknown-command (alist-ref data 'stacktrace) data)))
(("unknown error") (raise (make-condition &unknown-error (alist-ref data 'stacktrace) data)))
(("unknown method") (raise (make-condition &unknown-method (alist-ref data 'stacktrace) data)))
(("unsupported operation") (raise (make-condition &unsupported-operation (alist-ref data 'stacktrace) data)))
(else (raise (make-condition &wd-exception (alist-ref data 'stacktrace) data)))
)
)
;; conditions ends here
;; WebDriver
;; The core element of the library is the ~<WebDriver>~ class and its subclasses. The class has the following fields:
;; #+name: webdriver-class
;; [[file:webdriver.org::webdriver-class][webdriver-class]]
(define-class <WebDriver> ()
((browser #f)
(active? #f)
(browser-pid #f)
(server #f)
(port #f)
(session-id #f)
(prefs #f)
(capabilities #f)))
;; webdriver-class ends here
;; The parent class provides a handful of methods, but does not implement all of them; some are the sole responsibility of the subclass. The ~launch~ method, on the other hand, bears shared responsibility. It sets a finalizer to ensure termination of the web driver process in case the class is disposed of with a still-open driver.
;; #+name: webdriver-basics
;; [[file:webdriver.org::webdriver-basics][webdriver-basics]]
(define-method (launch #:after (instance <WebDriver>) options)
(set-finalizer! instance (lambda (obj)
(when (slot-value instance 'active?)
(terminate instance)))))
(define-method (terminate (instance <WebDriver>))
(terminate-session instance)
(process-signal (slot-value instance 'browser-pid))
(set! (slot-value instance 'browser-pid) #f)
(set! (slot-value instance 'active?) #f))
(define-method (construct-capabilities (instance <WebDriver>) #!optional caps)
(raise 'subclass-responsibility))
(define-method (postprocess-result (instance <WebDriver>) result)
result)
;; webdriver-basics ends here
;; Main initialization is done by calling the ~new-WebDriver~ procedure with the respective class name and optionally an alist of options.
;; #+name: webdriver-init
;; [[file:webdriver.org::webdriver-init][webdriver-init]]
(define (new-WebDriver browser #!optional options)
(let ((instance (make browser)))
(launch instance options)
(sleep 1)
instance))
;; webdriver-init ends here
;; Geckodriver
;; The Geckodriver is used to control Firefox.
;; #+name: geckodriver-basic
;; [[file:webdriver.org::geckodriver-basic][geckodriver-basic]]
(define-class <Gecko> (<WebDriver>)
((browser #:firefox)
(server "127.0.0.1")
(port 4444)))
(define-method (launch (instance <Gecko>) options)
(let ((pid (process-run "geckodriver > /dev/null 2>&1")))
(set! (slot-value instance 'browser-pid) pid)
(set! (slot-value instance 'active?) #t)
(set! (slot-value instance 'capabilities) options)))
;; geckodriver-basic ends here
;; The capabilities object for Geckodriver is of the form ={"capabilities": {...}}=.
;; For more information on capabilities, see https://developer.mozilla.org/en-US/docs/Web/WebDriver/Capabilities.
;; #+name: geckodriver-capabilities
;; [[file:webdriver.org::geckodriver-capabilities][geckodriver-capabilities]]
(define-method (construct-capabilities (instance <Gecko>))
(let ((caps (or (slot-value instance 'capabilities) (list))))
`((capabilities . ,caps))))
;; geckodriver-capabilities ends here
;; Sometimes, Geckodriver returns the results of a command in a JSON object with the sole key ="value"=. We have to correct that before returning the data to the user.
;; #+name: geckodriver-postprocess
;; [[file:webdriver.org::geckodriver-postprocess][geckodriver-postprocess]]
(define-method (postprocess-result (instance <Gecko>) result)
(alist-ref/default result 'value result))
;; geckodriver-postprocess ends here
;; Communication
;; Data is sent to the API via a central class method. For convenience, there is a ~send-with-session~ variant that automatically adds the session id.
;; #+name: wd-send
;; [[file:webdriver.org::wd-send][wd-send]]
(define-method (send (instance <WebDriver>) data uri method)
(let* ((remote (string-append "http://" (slot-value instance 'server) ":" (->string (slot-value instance 'port)) "/"))
(result (postprocess-result instance
(with-input-from-request
(make-request #:method method
#:uri (uri-reference (string-append remote uri))
#:headers (headers `((content-type application/json))))
(if data (json->string data) "")
read-json))))
(if (and (list? result) (alist-ref/default result 'error #f))
(wd-throw result)
result)))
(define-method (send-with-session (instance <WebDriver>) data uri method)
(send instance data (string-append "session/" (slot-value instance 'session-id) "/" uri) method))
;; wd-send ends here
;; Session management
;; Session management is very simple. There is just one method to initialize a new session. Everything else is handled automatically.
;; #+name: wd-init-session
;; [[file:webdriver.org::wd-init-session][wd-init-session]]
(define-method (initialize-session (instance <WebDriver>))
(let ((result (send instance (construct-capabilities instance) "session" 'POST)))
(set! (slot-value instance 'session-id) (alist-ref result 'sessionId))))
;; wd-init-session ends here
;; #+name: wd-term-session
;; [[file:webdriver.org::wd-term-session][wd-term-session]]
(define-method (terminate-session (instance <WebDriver>))
(when (slot-value instance 'session-id)
(send instance #f (string-append "session/" (slot-value instance 'session-id)) 'DELETE))
(set! (slot-value instance 'session-id) #f))
;; wd-term-session ends here
;; API Access Methods
;; #+name: wd-url
;; [[file:webdriver.org::wd-url][wd-url]]
(define-method (set-url (instance <WebDriver>) url)
(send-with-session instance `((url . ,url)) "url" 'POST))
(define-method (url (instance <WebDriver>))
(send-with-session instance #f "url" 'GET))
;; wd-url ends here
;; #+RESULTS: wd-url-test
;; : -- testing url ---------------------------------------------------------------
;; : Initial state ........................................................ [ PASS]
;; : Navigating to the first website ...................................... [ PASS]
;; : 2 tests completed in 5.247 seconds.
;; : 2 out of 2 (100%) tests passed.
;; : -- done testing url ----------------------------------------------------------
;; [[file:webdriver.org::*API Access Methods][API Access Methods:3]]
(define-method (back (instance <WebDriver>))
(send-with-session instance #f "back" 'POST))
;; API Access Methods:3 ends here
;; [[file:webdriver.org::*API Access Methods][API Access Methods:4]]
(define-method (forward (instance <WebDriver>))
(send-with-session instance #f "forward" 'POST))
;; API Access Methods:4 ends here
;; [[file:webdriver.org::*API Access Methods][API Access Methods:5]]
(define-method (refresh (instance <WebDriver>))
(send-with-session instance #f "refresh" 'POST))
;; API Access Methods:5 ends here
;; [[file:webdriver.org::*API Access Methods][API Access Methods:6]]
(define-method (title (instance <WebDriver>))
(send-with-session instance #f "title" 'GET))
;; API Access Methods:6 ends here
;; [[file:webdriver.org::*API Access Methods][API Access Methods:7]]
(define-method (status (instance <WebDriver>))
(send-with-session instance #f "status" 'GET))
;; API Access Methods:7 ends here
;; [[file:webdriver.org::*API Access Methods][API Access Methods:8]]
(define-method (source (instance <WebDriver>))
(send-with-session instance #f "source" 'GET))
;; API Access Methods:8 ends here
;; [[file:webdriver.org::*API Access Methods][API Access Methods:9]]
(define-method (screenshot (instance <WebDriver>))
(base64-decode (send-with-session instance #f "screenshot" 'GET)))
;; API Access Methods:9 ends here
;; [[file:webdriver.org::*API Access Methods][API Access Methods:10]]
(define-method (print-page (instance <WebDriver>))
(send-with-session instance #f "print" 'POST))
;; API Access Methods:10 ends here
;; [[file:webdriver.org::*API Access Methods][API Access Methods:11]]
(define-method (execute-async (instance <WebDriver>) script args)
(send-with-session instance `((script . ,script) (args . ,args)) "execute/async" 'POST))
;; API Access Methods:11 ends here
;; [[file:webdriver.org::*API Access Methods][API Access Methods:12]]
(define-method (execute-sync (instance <WebDriver>) script args)
(send-with-session instance `((script . ,script) (args . ,args)) "execute/sync" 'POST))
;; API Access Methods:12 ends here
;; Timeouts
;; The following timeouts are defined:
;; - =script=: defaults to 30'000, specifies when to interrupt a script that is being evaluated. A nil value implies that scripts should never be interrupted, but instead run indefinitely.
;; - =pageLoad=: defaults to 300'000, provides the timeout limit used to interrupt an explicit navigation attempt.
;; - =implicit=: defaults to 0, specifies a time to wait for the element location strategy to complete when locating an element.
;; [[file:webdriver.org::*Timeouts][Timeouts:1]]
(define-class <WDTimeouts> ()
((script 30000)
(pageLoad 300000)
(implicit 0)))
;; Timeouts:1 ends here
;; [[file:webdriver.org::*Timeouts][Timeouts:2]]
(define-method (extract (instance <WDTimeouts>))
`((script . ,(slot-value instance 'script))
(pageLoad . ,(slot-value instance 'pageLoad))
(implicit . ,(slot-value instance 'implicit))))
;; Timeouts:2 ends here
;; Setting and getting timeouts
;; [[file:webdriver.org::*Setting and getting timeouts][Setting and getting timeouts:1]]
(define-method (set-timeouts (instance <WebDriver>) (timeouts <WDTimeouts>))
(send-with-session instance (extract timeouts) "timeouts" 'POST))
(define-method (timeouts (instance <WebDriver>))
(let ((result (send-with-session instance #f "timeouts" 'GET)))
(make <WDTimeouts>
'script (alist-ref result 'script)
'pageLoad (alist-ref result 'pageLoad)
'implicit (alist-ref result 'implicit))))
;; Setting and getting timeouts:1 ends here
;; Element Class
;; [[file:webdriver.org::*Element Class][Element Class:1]]
(define-class <WDElement> ()
((driver #f)
(element #f)))
;; Element Class:1 ends here
;; [[file:webdriver.org::*Element Class][Element Class:2]]
(define-method (send-with-session (instance <WDElement>) data uri method)
(send-with-session (slot-value instance 'driver) data
(string-append "element/" (slot-value instance 'element) "/" uri)
method))
;; Element Class:2 ends here
;; Location Strategies
;; [[file:webdriver.org::*Location Strategies][Location Strategies:1]]
(define css-selector "css selector")
(define link-text "link text")
(define partial-link-text "partial link text")
(define tag-name "tag name")
(define xpath "xpath")
;; Location Strategies:1 ends here
;; Accessor Methods
;; [[file:webdriver.org::*Accessor Methods][Accessor Methods:1]]
(define-method (find-element (instance <WebDriver>) strategy selector)
(let ((result (send-with-session instance `((using . ,strategy) (value . ,selector)) "element" 'POST)))
(make <WDElement> 'driver instance 'element (car (alist-values result)))
element))
;; Accessor Methods:1 ends here
;; [[file:webdriver.org::*Accessor Methods][Accessor Methods:2]]
(define-method (find-elements (instance <WebDriver>) strategy selector)
(let ((result (send-with-session instance `((using . ,strategy) (value . ,selector)) "elements" 'POST)))
(map
(lambda (elem)
(make <WDElement> 'driver instance 'element (car (alist-values elem))))
result)))
;; Accessor Methods:2 ends here
;; [[file:webdriver.org::*Accessor Methods][Accessor Methods:3]]
(define-method (find-element (instance <WDElement>) strategy selector)
(let ((result (send-with-session instance `((using . ,strategy) (value . ,selector)) "element" 'POST)))
(make <WDElement> 'driver (slot-value instance 'driver) 'element (car (alist-values result)))
element))
;; Accessor Methods:3 ends here
;; [[file:webdriver.org::*Accessor Methods][Accessor Methods:4]]
(define-method (find-elements (instance <WDElement>) strategy selector)
(let ((result (send-with-session instance `((using . ,strategy) (value . ,selector)) "elements" 'POST)))
(map
(lambda (elem)
(make <WDElement> 'driver (slot-value instance 'driver) 'element (car (alist-values elem))))
result)))
;; Accessor Methods:4 ends here
;; Working with Elements
;; [[file:webdriver.org::*Working with Elements][Working with Elements:1]]
(define-method (attribute (instance <WDElement>) attribute)
(let ((result (send-with-session instance #f
(string-append "attribute/" attribute)
'GET)))
(if (equal? "true" result)
#t
result)))
;; Working with Elements:1 ends here
;; [[file:webdriver.org::*Working with Elements][Working with Elements:2]]
(define-method (property (instance <WDElement>) property)
(send-with-session instance #f (string-append "property/" property) 'GET))
;; Working with Elements:2 ends here
;; [[file:webdriver.org::*Working with Elements][Working with Elements:3]]
(define-method (clear (instance <WDElement>))
(send-with-session instance #f "clear" 'POST))
;; Working with Elements:3 ends here
;; [[file:webdriver.org::*Working with Elements][Working with Elements:4]]
(define-method (click (instance <WDElement>))
(send-with-session instance #f "click" 'POST))
;; Working with Elements:4 ends here
;; [[file:webdriver.org::*Working with Elements][Working with Elements:5]]
(define-method (computed-label (instance <WDElement>))
(send-with-session instance #f "computedlabel" 'GET))
;; Working with Elements:5 ends here
;; [[file:webdriver.org::*Working with Elements][Working with Elements:6]]
(define-method (computed-role (instance <WDElement>))
(send-with-session instance #f "computedrole" 'GET))
;; Working with Elements:6 ends here
;; [[file:webdriver.org::*Working with Elements][Working with Elements:7]]
(define-method (enabled? (instance <WDElement>))
(send-with-session instance #f "enabled" 'GET))
;; Working with Elements:7 ends here
;; [[file:webdriver.org::*Working with Elements][Working with Elements:8]]
(define-method (selected? (instance <WDElement>))
(send-with-session instance #f "selected" 'GET))
;; Working with Elements:8 ends here
;; [[file:webdriver.org::*Working with Elements][Working with Elements:9]]
(define-method (name (instance <WDElement>))
(send-with-session instance #f "name" 'GET))
;; Working with Elements:9 ends here
;; [[file:webdriver.org::*Working with Elements][Working with Elements:10]]
(define-method (rect (instance <WDElement>))
(send-with-session instance #f "rect" 'GET))
;; Working with Elements:10 ends here
;; [[file:webdriver.org::*Working with Elements][Working with Elements:11]]
(define-method (screenshot (instance <WDElement>))
(base64-decode (send-with-session instance #f "screenshot" 'GET)))
;; Working with Elements:11 ends here
;; [[file:webdriver.org::*Working with Elements][Working with Elements:12]]
(define-method (text (instance <WDElement>))
(send-with-session instance #f "text" 'GET))
;; Working with Elements:12 ends here
;; [[file:webdriver.org::*Working with Elements][Working with Elements:13]]
(define-method (set-value (instance <WDElement>) value)
(send-with-session instance `((text . ,value)) "value" 'POST))
;; Working with Elements:13 ends here
Reference in a new issue View git blame Copy permalink