try to send input
This commit is contained in:
parent
aa90607cc7
commit
81f8318e73
5 changed files with 74 additions and 19 deletions
|
@ -6,7 +6,7 @@ open Twitter
|
|||
let start driver =
|
||||
let name_driver = prepare driver in
|
||||
let data_driver = run_process name_driver [] in
|
||||
let session_id = get_session () in
|
||||
let session_id = get_session (* ~headless:false *) () in
|
||||
data_driver, session_id
|
||||
;;
|
||||
|
||||
|
|
|
@ -1,17 +1,24 @@
|
|||
open Pusk.Net
|
||||
open Pusk.Utils
|
||||
|
||||
let login_twitter ctx _username _password =
|
||||
(* Navigate to login page *)
|
||||
let login_twitter ctx username _password =
|
||||
(* Navigate to login page and wait for page loaded*)
|
||||
ignore (navigate ctx.session_id "https://twitter.com/i/flow/login");
|
||||
(* Extra wait to be sure the page is loaded *)
|
||||
Unix.sleep 5;
|
||||
(* Find username input *)
|
||||
let element_id =
|
||||
match
|
||||
find
|
||||
ctx.session_id
|
||||
(XPath
|
||||
"/html/body/div[1]/div/div/div[1]/div/div/div/div/div/div/div[2]/div[2]/div/div/div[2]/div[2]/div/div/div/div[5]/label")
|
||||
"/html/body/div[1]/div/div/div[1]/div/div/div/div/div/div/div[2]/div[2]/div/div/div[2]/div[2]/div/div/div/div[5]/label/div/div[2]/div/input")
|
||||
with
|
||||
| Some l -> List.iter (fun e -> print_endline (Yojson.Safe.to_string e)) l
|
||||
| None -> raise (Any "Username input not found")
|
||||
| [] -> raise (Any "Username input not found")
|
||||
| _ as l ->
|
||||
if List.length l > 1
|
||||
then raise (Any "Too many element found as the username input")
|
||||
else List.nth l 0
|
||||
in
|
||||
(* Insert the username *)
|
||||
send_keys ctx.session_id element_id username
|
||||
;;
|
||||
|
|
19
lib/json.ml
19
lib/json.ml
|
@ -1,17 +1,19 @@
|
|||
open Utils
|
||||
|
||||
let connection_payload =
|
||||
let connection_payload headless =
|
||||
fmt
|
||||
{|
|
||||
{
|
||||
"capabilities": {
|
||||
"alwaysMatch": {
|
||||
"moz:firefoxOptions": {
|
||||
"args": ["-headless"]
|
||||
"args": [%s]
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|}
|
||||
(if headless then "\"-headless\"" else "")
|
||||
;;
|
||||
|
||||
let navigate_payload url = fmt {|
|
||||
|
@ -35,3 +37,16 @@ let find_payload strategy value =
|
|||
}
|
||||
|} strategy value
|
||||
;;
|
||||
|
||||
let send_keys_payload text =
|
||||
fmt
|
||||
{|
|
||||
{
|
||||
"text": "%s",
|
||||
"value": %s
|
||||
}
|
||||
|}
|
||||
text
|
||||
(Yojson.Safe.to_string
|
||||
(`List (List.map (fun str -> `String str) (keys_to_typing text))))
|
||||
;;
|
||||
|
|
33
lib/net.ml
33
lib/net.ml
|
@ -29,8 +29,10 @@ let execute_get_request url = Lwt_main.run (send_get_request url)
|
|||
let execute_delete_request url = Lwt_main.run (send_delete_request url)
|
||||
|
||||
(* Server MUST be started already *)
|
||||
let get_session () =
|
||||
let response = execute_post_request (fmt "%s" driver_url) Json.connection_payload in
|
||||
let get_session ?(headless = true) () =
|
||||
let response =
|
||||
execute_post_request (fmt "%s" driver_url) (Json.connection_payload headless)
|
||||
in
|
||||
match Yojson.Safe.from_string response with
|
||||
| `Assoc fields ->
|
||||
let value = List.assoc "value" fields in
|
||||
|
@ -91,7 +93,30 @@ let find session_id strategy =
|
|||
match Yojson.Safe.from_string response with
|
||||
| `Assoc fields ->
|
||||
(match List.assoc "value" fields with
|
||||
| `List l -> Some l
|
||||
| _ -> None)
|
||||
| `List l ->
|
||||
List.fold_left
|
||||
(fun acc x ->
|
||||
match x with
|
||||
| `Assoc subfields ->
|
||||
List.fold_left
|
||||
(fun acc' (_, value) ->
|
||||
match value with
|
||||
| `String str -> str :: acc'
|
||||
| _ -> acc')
|
||||
acc
|
||||
subfields
|
||||
| _ -> acc)
|
||||
[]
|
||||
l
|
||||
| _ -> [])
|
||||
| _ -> raise (Any "wait_for_load | Invalid JSON")
|
||||
;;
|
||||
|
||||
let send_keys session_id element_id username =
|
||||
let response =
|
||||
execute_post_request
|
||||
(fmt "%s/element/%s/value" (driver session_id) element_id)
|
||||
(Json.send_keys_payload username)
|
||||
in
|
||||
print_endline response
|
||||
;;
|
||||
|
|
|
@ -9,3 +9,11 @@ let load_dotenv =
|
|||
let path = "config/.env" in
|
||||
if Sys.file_exists path then Dotenv.export ~path ()
|
||||
;;
|
||||
|
||||
let keys_to_typing str =
|
||||
let rec aux acc = function
|
||||
| 0 -> acc
|
||||
| n -> aux (String.sub str (n - 1) 1 :: acc) (n - 1)
|
||||
in
|
||||
aux [] (String.length str)
|
||||
;;
|
||||
|
|
Loading…
Reference in a new issue