steve
/
factor-work
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

cleanup

master
Steve Ayerhart 2024-03-25 22:21:10 -04:00
parent 24cf53329d
commit fa733853c3
1 changed files with 88 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

160
web-driver/web-driver.factor
View File

@ -1,5 +1,7 @@
USING: kernel http http.client http.server io.sockets io.streams.byte-array io.pathnames io.encodings.binary io.encodings.string io.encodings.utf8 io.launcher accessors urls parser effects.parser words arrays sequences quotations json.reader json.writer formatting assocs namespaces present hashtables words.symbol combinators lexer calendar prettyprint.backend base64 images.png destructors math.parser threads continuations ; USING: kernel accessors urls parser effects.parser words arrays sequences quotations json formatting assocs namespaces present hashtables words.symbol combinators lexer calendar prettyprint.backend base64 images.png destructors math.parser threads continuations ;
USING: http http.client http.server ;
USING: libc classes ; USING: libc classes ;
USING: io io.sockets io.streams.byte-array io.pathnames io.encodings.binary io.encodings.string io.encodings.utf8 io.launcher ;
USING: prettyprint ; USING: prettyprint ;
@ -16,7 +18,7 @@ CONSTANT: xpath-location-strategy "xpath"
SYMBOLS: current-web-driver current-web-driver-session ; SYMBOLS: current-web-driver current-web-driver-session ;
TUPLE: web-driver remote-url process ; TUPLE: web-driver process remote-url ;
TUPLE: web-driver-session session-id capabilities ; TUPLE: web-driver-session session-id capabilities ;
TUPLE: session-status message ready? ; TUPLE: session-status message ready? ;
@ -73,10 +75,15 @@ TUPLE: session-status message ready? ;
! Capabilities ! Capabilities
! https://www.w3.org/webdriver/#capabilities ! https://www.w3.org/webdriver/#capabilities
TUPLE: capabilities { always-match hashtable } { first-match hashtable } ; TUPLE: capabilities { always-match hashtable } { first-match sequence } ;
: <capabilities> ( always-match first-match -- capabilities ) : <capabilities> ( always-match first-match -- capabilities )
[ [ H{ } ] unless* ] bi@ capabilities boa ; [ [ H{ } ] unless* ]
[ [ { } ] unless* ] bi*
capabilities boa ;
: <no-capabilities> ( -- capabilities )
f f <capabilities> ;
: capabilities>json ( capabilities -- string ) : capabilities>json ( capabilities -- string )
[ always-match>> ] [ first-match>> ] bi [ always-match>> ] [ first-match>> ] bi
@ -84,9 +91,8 @@ TUPLE: capabilities { always-match hashtable } { first-match hashtable } ;
: <headless-firefox-capabilities> ( -- hash ) : <headless-firefox-capabilities> ( -- hash )
H{ H{
{ "browserName" "firefox" } { "moz:firefoxOptions" H{ { "args" { "-headless" } } } }
{ "moz:firefoxOptions" { "args" { "-headless" } } } } f <capabilities> capabilities>json ;
} ;
! Timeouts ! Timeouts
! https://www.w3.org/TR/webdriver/#timeouts ! https://www.w3.org/TR/webdriver/#timeouts
@ -249,32 +255,44 @@ TUPLE: rect x y width height ;
: execute-async-script ( script arguments -- return ) : execute-async-script ( script arguments -- return )
'H{ { "script" _ } { "args" _ } } "execute/async" <session-post-request> http-web-driver-request ; 'H{ { "script" _ } { "args" _ } } "execute/async" <session-post-request> http-web-driver-request ;
! cooHkies ! cookies
! TODO: samesite? TUPLE: cookie name value path domain secure? http-only? expiry same-site ;
: web-driver-cookie>cookie ( hashtable -- cookie ) : parse-cookie ( hashtable -- cookie )
{ {
[ "name" of ] [ "value" of f f ] [ "path" of ] [ "domain" of ] [ "name" of ]
[ "expiry" of f swap unix-time>timestamp ] [ "httpOnly" of ] [ "secure" of ] [ "value" of ]
[ "path" of [ "/" ] unless* ]
[ "domain" of ]
[ "secure" of ]
[ "httpOnly" of ]
[ "expiry" of [ unix-time>timestamp ] [ f ] if* ]
[ "sameSite" of ]
} cleave cookie boa ; } cleave cookie boa ;
: cookie>web-driver-cookie ( cookie -- hashtable ) : cookie>web-driver-cookie ( cookie -- hashtable )
tuple>assoc >hashtable [ tuple>assoc >hashtable [
[ "httpOnly" "http-only" rot rename-at ] {
[ "expiry" "max-age" rot rename-at ] bi [ "secure" "secure?" rot rename-at ]
] keep ; [ "httpOnly" "http-only?" rot rename-at ]
[ "sameSite" "same-site" rot rename-at ]
} cleave
] keep 'H{ { "cookie" _ } } ;
: get-all-cookies ( -- cookies ) : get-all-cookies ( -- cookies )
"cookie" <session-get-request> http-web-driver-request "cookie" <session-get-request> http-web-driver-request
[ web-driver-cookie>cookie ] map ; [ parse-cookie ] map ;
: get-named-cookie ( name -- value ) : get-named-cookie ( name -- value )
"cookie" prepend-path <session-get-request> http-web-driver-request web-driver-cookie>cookie ; "cookie" prepend-path <session-get-request> http-web-driver-request parse-cookie ;
: add-cookie ( cookie -- ) : add-cookie ( cookie -- )
cookie>web-driver-cookie "cookie" <session-post-request> http-web-driver-request drop ; cookie>web-driver-cookie "cookie" <session-post-request> http-web-driver-request drop ;
: add-cookies ( seq -- )
[ add-cookie ] each ;
: delete-cookie ( name -- ) : delete-cookie ( name -- )
"cookie" prepend-path <session-delete-request> http-web-driver-request drop ; "cookie" prepend-path <session-delete-request> http-web-driver-request drop ;
@ -308,19 +326,18 @@ TUPLE: rect x y width height ;
! TODO: Actions ! TODO: Actions
! TODO: handle driver processes better
! Sessions ! Sessions
! https://www.w3.org/TR/webdriver/#sessions ! https://www.w3.org/TR/webdriver/#sessions
: status ( -- session-status ) : status ( -- session-status )
[ ! [
"status" <web-driver-get-request> http-web-driver-request "status" <web-driver-get-request> http-web-driver-request
[ "message" of dup "" = [ drop f ] when ] [ "ready" of ] bi session-status boa [ "message" of dup "" = [ drop f ] when ] [ "ready" of ] bi session-status boa ;
] ! ]
[ \ libc-error instance? ] ignore-error/f f session-status boa ; ! [ \ libc-error instance? ] ignore-error/f "SUP" session-status boa ;
: <web-driver-session> ( capabilities -- json ) : <web-driver-session> ( capabilities -- json )
dup .
"session" <web-driver-post-request> http-web-driver-request "session" <web-driver-post-request> http-web-driver-request
[ "sessionId" of ] [ "capabilities" of ] bi web-driver-session boa ; [ "sessionId" of ] [ "capabilities" of ] bi web-driver-session boa ;
@ -331,61 +348,60 @@ TUPLE: rect x y width height ;
<any-port-local-inet4> utf8 <server> <any-port-local-inet4> utf8 <server>
[ addr>> port>> ] [ dispose ] bi number>string ; [ addr>> port>> ] [ dispose ] bi number>string ;
: <web-driver-process> ( host port command -- process ) : build-url ( host port -- url )
-rot '{ _ "--host" _ "--port" _ } utf8 <process-reader> ; ":" prepend append "http://" prepend "/" append >url ;
: <gecko-driver> ( host port -- gecko-driver ) ! TODO: handle missing binary
[ ":" prepend append "http://" prepend "/" append >url ]
[ "geckodriver" <web-driver-process> ] 2bi
web-driver boa ;
: with-gecko-driver ( host port quote -- ) : <gecko-driver-command-desc> ( -- desc )
[ [ ready?>> ] [ 1 seconds sleep status ] do until ] prepose { "geckodriver" "--log" "fatal" } ;
[ <gecko-driver> current-web-driver ] dip with-variable ; inline
: <chrome-driver-command-desc> ( -- desc )
{ "chromedriver" "--silent" } ;
: <web-driver-process> ( desc host port -- process )
"--port=" prepend
'{ "--host" _ _ } append utf8 <process-reader> ;
: <web-driver> ( command host port -- process )
[ <web-driver-process> ] 2keep build-url web-driver boa ;
: default-host/port ( -- host port )
"localhost" get-free-listen-port ;
: <gecko-driver> ( host port -- web-driver )
[ <gecko-driver-command-desc> ] 2dip <web-driver> ;
: <default-gecko-driver> ( -- web-driver )
default-host/port <gecko-driver> ;
: <chrome-driver> ( host port -- web-driver )
[ <chrome-driver-command-desc> ] 2dip <web-driver> ;
: <default-chrome-driver> ( -- web-driver )
default-host/port <chrome-driver> ;
: with-web-driver ( driver quote -- )
current-web-driver swap with-variable ; inline
: with-default-gecko-driver ( quote -- ) : with-default-gecko-driver ( quote -- )
[ "127.0.0.1" get-free-listen-port ] dip with-gecko-driver ; inline <default-gecko-driver> swap with-web-driver ; inline
: <chrome-driver> ( host port -- process )
[ ":" prepend append "http://" prepend "/" append >url ]
[ "chromedriver" <web-driver-process> ] 2bi
web-driver boa ;
: with-chrome-driver ( host port quote -- )
[ <chrome-driver> current-web-driver ] dip with-variable ; inline
: with-default-chrome-driver ( quote -- ) : with-default-chrome-driver ( quote -- )
[ "127.0.0.1" get-free-listen-port ] dip with-chrome-driver ; inline <default-chrome-driver> swap with-web-driver ; inline
! : with-default-gecko-session ( caps quote -- ) : with-web-driver-session ( capabilities driver quote -- )
! [ [
! 2drop dup current-web-driver [
! [ ready?>> ] [ 1 seconds sleep status ] do until [ ready?>> ] [ 1 seconds sleep status ] do until
! [ <web-driver-session> current-web-driver-session ] dip with-variable swap <web-driver-session>
! delete-session 'H{ { current-web-driver _ } { current-web-driver-session _ } }
! ] with-default-gecko-driver ; ] with-variable
] dip
with-variables ; inline
! : <web-driver-session> ( host port capabilities -- session ) : with-default-gecko-driver-session ( capabilities quote -- )
! [ <default-gecko-driver> swap with-web-driver-session ; inline
! [ <gecko-driver-process> ]
! [ ":" prepend append "http://" prepend "/" append ] 2bi
! ] dip
!
! [
! [ ready?>> ] [ 1 seconds sleep status ] do until
! ] dip
!
! 2dup new-session new-session [ "sessionId" of ] [ "capabilities" of ] bi
!
! : init-driver-session ( -- )
! f f web-driver-session boa
! : <web-driver-session> ( capabilities -- session ) : with-default-chrome-driver-session ( capabilities quote -- )
! init-driver-session <default-chrome-driver> swap with-web-driver-session ; inline
!
! [ ready?>> ] [ 1 seconds sleep status ] do until
!
! new-session [ "sessionId" of ] [ "capabilities" of ] bi
!
! current-web-driver-session> swap >>capabilities swap >>session-id
! >current-web-driver-session ;