diff --git a/tezt/lib_tezos/RPC.ml b/tezt/lib_tezos/RPC.ml index 32a903bc770ec3c974159868c0fd4fa46db433ea..475ef8c541cb53d466ea150cb07448cb2215a1a8 100644 --- a/tezt/lib_tezos/RPC.ml +++ b/tezt/lib_tezos/RPC.ml @@ -24,6 +24,8 @@ (* *) (*****************************************************************************) +module Client = Client_base + let get_connections ?endpoint ?hooks ?peer_id client = match peer_id with | None -> @@ -781,61 +783,83 @@ let raw_bytes ?endpoint ?hooks ?(chain = "main") ?(block = "head") ?(path = []) in Client.rpc ?endpoint ?hooks GET path client -module Curl = struct - let curl_path_cache = ref None - - let get () = - Process.( - try - let* curl_path = - match !curl_path_cache with - | Some curl_path -> return curl_path - | None -> - let* curl_path = - run_and_read_stdout "sh" ["-c"; "command -v curl"] +module Monitor = struct + let generic_monitor ?endpoint ?(query_string = []) ~path client on_value = + let endpoint = + match endpoint with + | Some e -> e + | None -> Option.get Client.(get_mode client |> mode_to_endpoint) + in + let host, port = + match endpoint with + | Node n -> (Node.rpc_host n, Node.rpc_port n) + | Proxy_server s -> ("localhost", Proxy_server.rpc_port s) + in + let node_addr = Printf.sprintf "http://%s:%d" host port in + let url = String.concat "/" (node_addr :: path) in + let* curl = Curl.stream () in + match curl with + | None -> + Format.ksprintf + failwith + "curl command must be available to stream call streamed RPC: %s" + url + | Some curl_stream -> + let url = + match query_string with + | [] -> url + | _ -> + let query = + List.map + (fun (arg, value) -> Printf.sprintf "%s=%s" arg value) + query_string + |> String.concat "&" in - let curl_path = String.trim curl_path in - curl_path_cache := Some curl_path ; - return curl_path + String.concat "?" [url; query] in - return - @@ Some - (fun ~url -> - let* output = run_and_read_stdout curl_path ["-s"; url] in - return (JSON.parse ~origin:url output)) - with _ -> return @@ None) - - let post () = - Process.( - try - let* curl_path = - match !curl_path_cache with - | Some curl_path -> return curl_path - | None -> - let* curl_path = - run_and_read_stdout "sh" ["-c"; "command -v curl"] + let stream, close = curl_stream ~url in + let rec loop () = + let* json_opt = Lwt_stream.get stream in + match json_opt with + | None -> unit + | Some json -> ( + let* res = + Lwt.catch (fun () -> on_value json) (fun _ -> return `Stop) in - let curl_path = String.trim curl_path in - curl_path_cache := Some curl_path ; - return curl_path + match res with + | `Stop -> unit + | `Continue -> + (* Stream is still open and user wants more elements *) + loop ()) in - return - @@ Some - (fun ~url data -> - let* output = - run_and_read_stdout - curl_path - [ - "-X"; - "POST"; - "-H"; - "Content-Type: application/json"; - "-s"; - url; - "-d"; - JSON.encode data; - ] - in - return (JSON.parse ~origin:url output)) - with _ -> return @@ None) + let promise = loop () in + Lwt.on_cancel promise close ; + let* () = promise in + close () ; + unit + + let operations ?endpoint ?(chain = "main") ?applied ?refused ?outdated + ?branch_refused ?branch_delayed client on_operation = + let path = ["chains"; chain; "mempool"; "monitor_operations"] in + let add_param arg name query = + match arg with + | None -> query + | Some arg -> (name, string_of_bool arg) :: query + in + let query_string = + [] + |> add_param applied "applied" + |> add_param refused "refused" + |> add_param outdated "outdated" + |> add_param branch_refused "branch_refused" + |> add_param branch_delayed "branch_delayed" + in + generic_monitor ?endpoint ~path ~query_string client on_operation + + let heads ?endpoint ?(chain = "main") ?next_protocol client on_head = + let path = ["monitor"; "heads"; chain] in + let query_string = + Option.map (fun p -> [("next_protocol", p)]) next_protocol + in + generic_monitor ?endpoint ~path ?query_string client on_head end diff --git a/tezt/lib_tezos/RPC.mli b/tezt/lib_tezos/RPC.mli index 5e49167be803c589fcfc80d4a332e5d84f5917c3..6e9f1f5df3243502860f6a2ce0aaf0de865a24d3 100644 --- a/tezt/lib_tezos/RPC.mli +++ b/tezt/lib_tezos/RPC.mli @@ -24,6 +24,8 @@ (* *) (*****************************************************************************) +module Client = Client_base + (** In all RPCs, default [chain] is "main" and default [block] is "head~2" to pick the finalized branch for Tenderbake. *) @@ -1068,13 +1070,27 @@ val raw_bytes : Client.t -> JSON.t Lwt.t -module Curl : sig - (** [get ()] returns [Some curl] where [curl ~url] returns the raw response obtained - by curl when requesting [url]. Returns [None] if [curl] cannot be found. *) - val get : unit -> (url:string -> JSON.t Lwt.t) option Lwt.t +module Monitor : sig + (** Call RPC /chain/[chain]/mempool/monitor_operations **) + val operations : + ?endpoint:Client.endpoint -> + (* ?hooks:Process.hooks -> *) + ?chain:string -> + ?applied:bool -> + ?refused:bool -> + ?outdated:bool -> + ?branch_refused:bool -> + ?branch_delayed:bool -> + Client.t -> + (JSON.t -> [`Continue | `Stop] Lwt.t) -> + unit Lwt.t - (** [post data] returns [Some curl] where [curl ~url data] returns the raw - response obtained by curl when posting the data to [url]. Returns [None] if - [curl] cannot be found. *) - val post : unit -> (url:string -> JSON.t -> JSON.t Lwt.t) option Lwt.t + (** Call RPC /monitor/heads/[chain] **) + val heads : + ?endpoint:Client.endpoint -> + ?chain:string -> + ?next_protocol:string -> + Client.t -> + (JSON.t -> [`Continue | `Stop] Lwt.t) -> + unit Lwt.t end diff --git a/tezt/lib_tezos/client.ml b/tezt/lib_tezos/client.ml index 0b64e70d59b149ba1fc7782e07af48b24b6264ac..4901cbce561c97f809c9f738c9ccc36227f1801d 100644 --- a/tezt/lib_tezos/client.ml +++ b/tezt/lib_tezos/client.ml @@ -24,34 +24,7 @@ (*****************************************************************************) open Runnable.Syntax - -type endpoint = Node of Node.t | Proxy_server of Proxy_server.t - -type media_type = Json | Binary | Any - -let rpc_port = function - | Node n -> Node.rpc_port n - | Proxy_server ps -> Proxy_server.rpc_port ps - -type mode = - | Client of endpoint option * media_type option - | Mockup - | Light of float * endpoint list - | Proxy of endpoint - -type mockup_sync_mode = Asynchronous | Synchronous - -type normalize_mode = Readable | Optimized | Optimized_legacy - -type t = { - path : string; - admin_path : string; - name : string; - color : Log.Color.t; - base_dir : string; - mutable additional_bootstraps : Account.key list; - mutable mode : mode; -} +include Client_base type stresstest_gas_estimation = { regular : int; @@ -64,238 +37,101 @@ type stresstest_contract_parameters = { invocation_gas_limit : int; } -let name t = t.name - -let base_dir t = t.base_dir - -let additional_bootstraps t = t.additional_bootstraps - -let get_mode t = t.mode - -let set_mode mode t = t.mode <- mode - -let next_name = ref 1 - -let fresh_name () = - let index = !next_name in - incr next_name ; - "client" ^ string_of_int index - -let () = Test.declare_reset_function @@ fun () -> next_name := 1 - -let runner endpoint = - match endpoint with - | Node node -> Node.runner node - | Proxy_server ps -> Proxy_server.runner ps - -let address ?(hostname = false) ?from peer = - match from with - | None -> Runner.address ~hostname (runner peer) - | Some endpoint -> - Runner.address ~hostname ?from:(runner endpoint) (runner peer) - let optional_switch ~name = function false -> [] | true -> ["--" ^ name] let optional_arg ~name f = function None -> [] | Some x -> ["--" ^ name; f x] -let create_with_mode ?(path = Constant.tezos_client) - ?(admin_path = Constant.tezos_admin_client) ?name - ?(color = Log.Color.FG.blue) ?base_dir mode = - let name = match name with None -> fresh_name () | Some name -> name in - let base_dir = - match base_dir with None -> Temp.dir name | Some dir -> dir +let wait_monitor_operation ?endpoint operation_hash_promise (client : t) = + let promise, resolver = Lwt.task () in + let* () = + RPC.Monitor.operations + ?endpoint + ~applied:true + ~refused:true + ~branch_delayed:true + ~outdated:true + ~branch_refused:true + client + @@ fun json -> + let mempool = JSON.as_list json in + let* expected_operation_hash = operation_hash_promise in + match + List.find_opt + (fun op -> + let operation_hash = JSON.(op |-> "hash" |> as_string) in + operation_hash = expected_operation_hash) + mempool + with + | None -> return `Continue + | Some op -> + let error = JSON.(op |-> "error") in + if not (JSON.is_null error) then ( + Lwt.cancel promise ; + Test.fail + "Operation %s is in mempool with error: %s" + expected_operation_hash + (JSON.encode error)) + else ( + Lwt.wakeup_later resolver op ; + return `Stop) in - let additional_bootstraps = [] in - {path; admin_path; name; color; base_dir; additional_bootstraps; mode} - -let create ?path ?admin_path ?name ?color ?base_dir ?endpoint ?media_type () = - create_with_mode - ?path - ?admin_path - ?name - ?color - ?base_dir - (Client (endpoint, media_type)) - -let base_dir_arg client = ["--base-dir"; client.base_dir] - -(* To avoid repeating unduly the sources file name, we create a function here - to get said file name as string. - Do not call it from a client in Mockup or Client (nominal) mode. *) -let sources_file client = - match client.mode with - | Mockup | Client _ | Proxy _ -> assert false - | Light _ -> client.base_dir // "sources.json" - -let mode_to_endpoint = function - | Client (None, _) | Mockup | Light (_, []) -> None - | Client (Some endpoint, _) | Light (_, endpoint :: _) | Proxy endpoint -> - Some endpoint - -(* [?endpoint] can be used to override the default node stored in the client. - Mockup nodes do not use [--endpoint] at all: RPCs are mocked up. - Light mode needs a file (specified with [--sources] on the CLI) - that contains a list of endpoints. -*) -let endpoint_arg ?(endpoint : endpoint option) client = - let either o1 o2 = match (o1, o2) with Some _, _ -> o1 | _ -> o2 in - (* pass [?endpoint] first: it has precedence over client.mode *) - match either endpoint (mode_to_endpoint client.mode) with - | None -> [] - | Some e -> - ["--endpoint"; sf "http://%s:%d" (address ~hostname:true e) (rpc_port e)] - -let media_type_arg client = - match client with - | Client (_, Some media_type) -> ( - match media_type with - | Json -> ["--media-type"; "json"] - | Binary -> ["--media-type"; "binary"] - | Any -> ["--media-type"; "any"]) - | _ -> [] - -let mode_arg client = - match client.mode with - | Client _ -> [] - | Mockup -> ["--mode"; "mockup"] - | Light _ -> ["--mode"; "light"; "--sources"; sources_file client] - | Proxy _ -> ["--mode"; "proxy"] - -let spawn_command ?log_command ?log_status_on_exit ?log_output - ?(env = String_map.empty) ?endpoint ?hooks ?(admin = false) client command = - let env = - (* Set disclaimer to "Y" if unspecified, otherwise use given value *) - String_map.update - "TEZOS_CLIENT_UNSAFE_DISABLE_DISCLAIMER" - (fun o -> Option.value ~default:"Y" o |> Option.some) - env + promise + +let with_monitor_injection ?(timeout = 10) ?endpoint (client : t) spawn_inject = + let oph_promise, oph_resolver = Lwt.task () in + let monitor = + let* _ = wait_monitor_operation ?endpoint oph_promise client in + return `Found_operation in - Process.spawn - ~name:client.name - ~color:client.color - ~env - ?log_command - ?log_status_on_exit - ?log_output - ?hooks - (if admin then client.admin_path else client.path) - @@ endpoint_arg ?endpoint client - @ media_type_arg client.mode @ mode_arg client @ base_dir_arg client @ command - -let url_encode str = - let buffer = Buffer.create (String.length str * 3) in - for i = 0 to String.length str - 1 do - match str.[i] with - | ('a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '.' | '_' | '-' | '/') as c -> - Buffer.add_char buffer c - | c -> - Buffer.add_char buffer '%' ; - let c1, c2 = Hex.of_char c in - Buffer.add_char buffer c1 ; - Buffer.add_char buffer c2 - done ; - let result = Buffer.contents buffer in - Buffer.reset buffer ; - result - -type meth = GET | PUT | POST | PATCH | DELETE - -let string_of_meth = function - | GET -> "get" - | PUT -> "put" - | POST -> "post" - | PATCH -> "patch" - | DELETE -> "delete" - -type path = string list - -let string_of_path path = "/" ^ String.concat "/" (List.map url_encode path) - -type query_string = (string * string) list - -let string_of_query_string = function - | [] -> "" - | qs -> - let qs' = List.map (fun (k, v) -> (url_encode k, url_encode v)) qs in - "?" ^ String.concat "&" @@ List.map (fun (k, v) -> k ^ "=" ^ v) qs' - -let rpc_path_query_to_string ?(query_string = []) path = - string_of_path path ^ string_of_query_string query_string - -module Spawn = struct - let rpc ?log_command ?log_status_on_exit ?log_output ?(better_errors = false) - ?endpoint ?hooks ?env ?data ?query_string meth path client : - JSON.t Runnable.process = - let process = - let data = - Option.fold ~none:[] ~some:(fun x -> ["with"; JSON.encode_u x]) data - in - let query_string = - Option.fold ~none:"" ~some:string_of_query_string query_string + let process = spawn_inject ?endpoint client in + let* client_output = Process.check_and_read_stdout process in + match client_output =~* rex "Operation hash is '(.*)'" with + | None -> + Test.fail + "Cannot extract operation hash from client_output: %s" + client_output + | Some oph -> ( + Lwt.wakeup_later oph_resolver oph ; + let timeout_promise = + let* () = Lwt_unix.sleep (float_of_int timeout) in + return `Timeout in - let path = string_of_path path in - let full_path = path ^ query_string in - let better_error = if better_errors then ["--better-errors"] else [] in - spawn_command - ?log_command - ?log_status_on_exit - ?log_output - ?endpoint - ?hooks - ?env - client - (better_error @ ["rpc"; string_of_meth meth; full_path] @ data) + let* result = Lwt.pick [monitor; timeout_promise] in + match result with + | `Timeout -> + Test.fail + "Operation %s was not seen in mempool after %d seconds" + oph + timeout + | `Found_operation -> return (process, client_output)) + +let check_injection ?(monitor_mempool = true) ?(expect_failure = false) ?timeout + ?endpoint (client : t) spawn_inject = + if expect_failure || not monitor_mempool then + spawn_inject ?endpoint client |> Process.check ~expect_failure + else + let* _ = with_monitor_injection ?timeout ?endpoint client spawn_inject in + unit + +let check_injection_output ?(monitor_mempool = true) ?(expect_failure = false) + ?timeout ?endpoint (client : t) spawn_inject = + if expect_failure || not monitor_mempool then + spawn_inject ?endpoint client + |> Process.check_and_read_stdout ~expect_failure + else + let* _, output = + with_monitor_injection ?timeout ?endpoint client spawn_inject in - let parse process = - let* output = Process.check_and_read_stdout process in - return (JSON.parse ~origin:(string_of_path path ^ " response") output) + return output + +let check_injection_process ?(monitor_mempool = true) ?timeout ?endpoint + (client : t) spawn_inject = + if not monitor_mempool then return (spawn_inject ?endpoint client) + else + let* process, _ = + with_monitor_injection ?timeout ?endpoint client spawn_inject in - {value = process; run = parse} -end - -let spawn_rpc ?log_command ?log_status_on_exit ?log_output ?better_errors - ?endpoint ?hooks ?env ?data ?query_string meth path client = - let*? res = - Spawn.rpc - ?log_command - ?log_status_on_exit - ?log_output - ?better_errors - ?endpoint - ?hooks - ?env - ?data - ?query_string - meth - path - client - in - res - -let rpc ?log_command ?log_status_on_exit ?log_output ?better_errors ?endpoint - ?hooks ?env ?data ?query_string meth path client = - let*! res = - Spawn.rpc - ?log_command - ?log_status_on_exit - ?log_output - ?better_errors - ?endpoint - ?hooks - ?env - ?data - ?query_string - meth - path - client - in - return res - -let spawn_rpc_list ?endpoint client = - spawn_command ?endpoint client ["rpc"; "list"] - -let rpc_list ?endpoint client = - spawn_rpc_list ?endpoint client |> Process.check_and_read_stdout + return process let spawn_shell_header ?endpoint ?(chain = "main") ?(block = "head") client = let path = ["chains"; chain; "blocks"; block; "header"; "shell"] in @@ -520,7 +356,7 @@ let bake_for_and_wait ?endpoint ?protocol ?keys ?minimal_fees match node with | Some n -> n | None -> ( - match node_of_client_mode client.mode with + match node_of_client_mode (get_mode client) with | Some n -> n | None -> Test.fail "No node found for bake_for_and_wait") in @@ -594,16 +430,18 @@ let spawn_propose_for ?endpoint ?minimal_timestamp ?protocol ?key ?force client ?force client -let endorse_for ?endpoint ?protocol ?key ?force client = - spawn_endorse_for ?endpoint ?protocol ?key ?force client |> Process.check +let endorse_for ?monitor_mempool ?endpoint ?protocol ?key ?force client = + check_injection ?monitor_mempool ?endpoint client + @@ spawn_endorse_for ?protocol ?key ?force -let preendorse_for ?endpoint ?protocol ?key ?force client = - spawn_preendorse_for ?endpoint ?protocol ?key ?force client |> Process.check +let preendorse_for ?monitor_mempool ?endpoint ?protocol ?key ?force client = + check_injection ?monitor_mempool ?endpoint client + @@ spawn_preendorse_for ?protocol ?key ?force -let propose_for ?endpoint ?(minimal_timestamp = true) ?protocol ?key ?force - client = - spawn_propose_for ?endpoint ?protocol ?key ?force ~minimal_timestamp client - |> Process.check +let propose_for ?monitor_mempool ?endpoint ?(minimal_timestamp = true) ?protocol + ?key ?force client = + check_injection ?monitor_mempool ?endpoint client + @@ spawn_propose_for ?protocol ?key ?force ~minimal_timestamp let id = ref 0 @@ -724,27 +562,25 @@ let spawn_transfer ?hooks ?log_output ?endpoint ?(wait = "none") ?burn_cap ?fee @ (if simulation then ["--simulation"] else []) @ if force then ["--force"] else []) -let transfer ?hooks ?log_output ?endpoint ?wait ?burn_cap ?fee ?gas_limit - ?storage_limit ?counter ?arg ?simulation ?force ?expect_failure ~amount - ~giver ~receiver client = - spawn_transfer - ?log_output - ?endpoint - ?hooks - ?wait - ?burn_cap - ?fee - ?gas_limit - ?storage_limit - ?counter - ?arg - ?simulation - ?force - ~amount - ~giver - ~receiver - client - |> Process.check ?expect_failure +let transfer ?monitor_mempool ?hooks ?log_output ?endpoint ?wait ?burn_cap ?fee + ?gas_limit ?storage_limit ?counter ?arg ?simulation ?force ?expect_failure + ~amount ~giver ~receiver client = + check_injection ?monitor_mempool ?endpoint ?expect_failure client + @@ spawn_transfer + ?log_output + ?hooks + ?wait + ?burn_cap + ?fee + ?gas_limit + ?storage_limit + ?counter + ?arg + ?simulation + ?force + ~amount + ~giver + ~receiver let spawn_multiple_transfers ?log_output ?endpoint ?(wait = "none") ?burn_cap ?fee_cap ?gas_limit ?storage_limit ?counter ?arg ~giver ~json_batch client = @@ -764,22 +600,20 @@ let spawn_multiple_transfers ?log_output ?endpoint ?(wait = "none") ?burn_cap @ optional_arg ~name:"counter" string_of_int counter @ optional_arg ~name:"arg" Fun.id arg) -let multiple_transfers ?log_output ?endpoint ?wait ?burn_cap ?fee_cap ?gas_limit - ?storage_limit ?counter ?arg ~giver ~json_batch client = - spawn_multiple_transfers - ?log_output - ?endpoint - ?wait - ?burn_cap - ?fee_cap - ?gas_limit - ?storage_limit - ?counter - ?arg - ~giver - ~json_batch - client - |> Process.check +let multiple_transfers ?monitor_mempool ?log_output ?endpoint ?wait ?burn_cap + ?fee_cap ?gas_limit ?storage_limit ?counter ?arg ~giver ~json_batch client = + check_injection ?monitor_mempool ?endpoint client + @@ spawn_multiple_transfers + ?log_output + ?wait + ?burn_cap + ?fee_cap + ?gas_limit + ?storage_limit + ?counter + ?arg + ~giver + ~json_batch let spawn_get_delegate ?endpoint ~src client = spawn_command ?endpoint client ["get"; "delegate"; "for"; src] @@ -824,8 +658,9 @@ let spawn_withdraw_delegate ?endpoint ?(wait = "none") ~src client = client (["--wait"; wait] @ ["withdraw"; "delegate"; "for"; src]) -let withdraw_delegate ?endpoint ?wait ~src client = - spawn_withdraw_delegate ?endpoint ?wait ~src client |> Process.check +let withdraw_delegate ?monitor_mempool ?endpoint ?wait ~src client = + check_injection ?monitor_mempool ?endpoint client + @@ spawn_withdraw_delegate ?wait ~src let spawn_get_balance_for ?endpoint ~account client = spawn_command ?endpoint client ["get"; "balance"; "for"; account] @@ -851,51 +686,60 @@ let create_mockup ?sync_mode ?parameter_file ~protocol client = spawn_create_mockup ?sync_mode ?parameter_file ~protocol client |> Process.check -let spawn_submit_proposals ?(key = Constant.bootstrap1.alias) ?(wait = "none") - ?proto_hash ?(proto_hashes = []) client = +let spawn_submit_proposals ?endpoint ?(key = Constant.bootstrap1.alias) + ?(wait = "none") ?proto_hash ?(proto_hashes = []) client = let proto_hashes = match proto_hash with None -> proto_hashes | Some h -> h :: proto_hashes in spawn_command + ?endpoint client ("--wait" :: wait :: "submit" :: "proposals" :: "for" :: key :: proto_hashes) -let submit_proposals ?key ?wait ?proto_hash ?proto_hashes client = - spawn_submit_proposals ?key ?wait ?proto_hash ?proto_hashes client - |> Process.check +let submit_proposals ?monitor_mempool ?endpoint ?key ?wait ?proto_hash + ?proto_hashes client = + check_injection ?monitor_mempool ?endpoint client + @@ spawn_submit_proposals ?key ?wait ?proto_hash ?proto_hashes type ballot = Nay | Pass | Yay -let spawn_submit_ballot ?(key = Constant.bootstrap1.alias) ?(wait = "none") - ~proto_hash vote client = +let spawn_submit_ballot ?endpoint ?(key = Constant.bootstrap1.alias) + ?(wait = "none") ~proto_hash ~vote client = let string_of_vote = function | Yay -> "yay" | Nay -> "nay" | Pass -> "pass" in spawn_command + ?endpoint client (["--wait"; wait] @ ["submit"; "ballot"; "for"; key; proto_hash; string_of_vote vote]) -let submit_ballot ?key ?wait ~proto_hash vote client = - spawn_submit_ballot ?key ?wait ~proto_hash vote client |> Process.check +let submit_ballot ?monitor_mempool ?endpoint ?key ?wait ~proto_hash vote client + = + check_injection ?monitor_mempool ?endpoint client + @@ spawn_submit_ballot ?key ?wait ~proto_hash ~vote -let set_deposits_limit ?hooks ?endpoint ?(wait = "none") ~src ~limit client = +let set_deposits_limit ?monitor_mempool ?hooks ?endpoint ?(wait = "none") ~src + ~limit client = + check_injection_output ?monitor_mempool ?endpoint client + @@ fun ?endpoint client -> spawn_command - ?hooks ?endpoint + ?hooks client (["--wait"; wait] @ ["set"; "deposits"; "limit"; "for"; src; "to"; limit]) - |> Process.check_and_read_stdout -let unset_deposits_limit ?hooks ?endpoint ?(wait = "none") ~src client = +let unset_deposits_limit ?monitor_mempool ?hooks ?endpoint ?(wait = "none") ~src + client = + check_injection_output ?monitor_mempool ?endpoint client + @@ fun ?endpoint client -> spawn_command ?hooks ?endpoint client (["--wait"; wait] @ ["unset"; "deposits"; "limit"; "for"; src]) - |> Process.check_and_read_stdout let spawn_originate_contract ?hooks ?log_output ?endpoint ?(wait = "none") ?init ?burn_cap ~alias ~amount ~src ~prg client = @@ -935,22 +779,20 @@ let convert_script_to_json ?endpoint ~script client = let convert_data_to_json ?endpoint ~data client = convert_michelson_to_json ~kind:"data" ?endpoint ~input:data client -let originate_contract ?hooks ?log_output ?endpoint ?wait ?init ?burn_cap ~alias - ~amount ~src ~prg client = +let originate_contract ?monitor_mempool ?hooks ?log_output ?endpoint ?wait ?init + ?burn_cap ~alias ~amount ~src ~prg client = let* client_output = - spawn_originate_contract - ?endpoint - ?log_output - ?hooks - ?wait - ?init - ?burn_cap - ~alias - ~amount - ~src - ~prg - client - |> Process.check_and_read_stdout + check_injection_output ?monitor_mempool ?endpoint client + @@ spawn_originate_contract + ?log_output + ?hooks + ?wait + ?init + ?burn_cap + ~alias + ~amount + ~src + ~prg in match client_output =~* rex "New contract ?(KT1\\w{33})" with | None -> @@ -1002,7 +844,7 @@ let spawn_stresstest ?endpoint ?(source_aliases = []) ?(source_pkhs = []) (* It is important to write the sources to a file because if we use a few thousands of sources the command line becomes too long. *) let sources_filename = - Temp.file (Format.sprintf "sources-%s.json" client.name) + Temp.file (Format.sprintf "sources-%s.json" (name client)) in with_open_out sources_filename (fun ch -> output_string ch (JSON.encode_u sources)) ; @@ -1144,18 +986,20 @@ let run_script ?hooks ?balance ?self_address ?source ?payer ~prg ~storage ~input client_output | Some storage -> return @@ String.trim storage -let spawn_register_global_constant ?(wait = "none") ?burn_cap ~value ~src client - = +let spawn_register_global_constant ?endpoint ?(wait = "none") ?burn_cap ~value + ~src client = spawn_command + ?endpoint client (["--wait"; wait] @ ["register"; "global"; "constant"; value; "from"; src] @ optional_arg ~name:"burn-cap" Tez.to_string burn_cap) -let register_global_constant ?wait ?burn_cap ~src ~value client = +let register_global_constant ?monitor_mempool ?endpoint ?wait ?burn_cap ~src + ~value client = let* client_output = - spawn_register_global_constant ?wait ?burn_cap ~src ~value client - |> Process.check_and_read_stdout + check_injection_output ?monitor_mempool ?endpoint client + @@ spawn_register_global_constant ?wait ?burn_cap ~src ~value in match client_output =~* rex "Global address: (expr\\w{50})" with | None -> @@ -1315,50 +1159,56 @@ let sign_block client block_hex ~delegate = spawn_sign_block client block_hex ~delegate |> Process.check_and_read_stdout module Tx_rollup = struct - let originate ?(wait = "none") ?(burn_cap = Tez.of_int 9_999_999) - ?(storage_limit = 60_000) ?fee ?hooks ~src client = - let process = - spawn_command - ?hooks - client - ([ - "--wait"; - wait; - "originate"; - "tx"; - "rollup"; - "from"; - src; - "--burn-cap"; - Tez.to_string burn_cap; - "--storage-limit"; - string_of_int storage_limit; - ] - @ Option.fold - ~none:[] - ~some:(fun f -> - [ - "--fee"; - Tez.to_string f; - "--force-low-fee"; - "--fee-cap"; - Tez.to_string f; - ]) - fee) - in - - let parse process = - let* output = Process.check_and_read_stdout process in - output - =~* rex "Originated tx rollup: ?(\\w*)" - |> mandatory "tx rollup hash" |> Lwt.return + let spawn_originate ?endpoint ?(wait = "none") + ?(burn_cap = Tez.of_int 9_999_999) ?(storage_limit = 60_000) ?fee ?hooks + ~src client = + spawn_command + ?endpoint + ?hooks + client + ([ + "--wait"; + wait; + "originate"; + "tx"; + "rollup"; + "from"; + src; + "--burn-cap"; + Tez.to_string burn_cap; + "--storage-limit"; + string_of_int storage_limit; + ] + @ Option.fold + ~none:[] + ~some:(fun f -> + [ + "--fee"; + Tez.to_string f; + "--force-low-fee"; + "--fee-cap"; + Tez.to_string f; + ]) + fee) + + let originate ?monitor_mempool ?endpoint ?wait ?burn_cap ?storage_limit ?fee + ?hooks ~src client = + let* output = + check_injection_output ?monitor_mempool ?endpoint client + @@ spawn_originate ?wait ?burn_cap ?storage_limit ?fee ?hooks ~src in - {value = process; run = parse} + output + =~* rex "Originated tx rollup: ?(\\w*)" + |> mandatory "tx rollup hash" |> return - let submit_batch ?(wait = "none") ?burn_cap ?storage_limit ?hooks ?log_output - ?log_command ~content:(`Hex content) ~rollup ~src client = + let submit_batch ?monitor_mempool ?endpoint ?(wait = "none") ?burn_cap + ?storage_limit ?hooks ?log_output ?log_command ~content:(`Hex content) + ~rollup ~src client = let process = + check_injection_process ?monitor_mempool ?endpoint client + @@ fun ?endpoint client -> spawn_command + ?endpoint ?hooks ?log_output ?log_command @@ -1378,13 +1228,17 @@ module Tx_rollup = struct @ optional_arg ~name:"burn-cap" Tez.to_string burn_cap @ optional_arg ~name:"storage-limit" string_of_int storage_limit) in - let parse process = Process.check process in + let parse process = Lwt.bind process Process.check in {value = process; run = parse} - let submit_commitment ?(wait = "none") ?burn_cap ?storage_limit ?hooks - ?predecessor ~level ~roots ~inbox_merkle_root ~rollup ~src client = + let submit_commitment ?monitor_mempool ?endpoint ?(wait = "none") ?burn_cap + ?storage_limit ?hooks ?predecessor ~level ~roots ~inbox_merkle_root + ~rollup ~src client = let process = + check_injection_process ?monitor_mempool ?endpoint client + @@ fun ?endpoint client -> spawn_command + ?endpoint ?hooks client (["--wait"; wait] @@ -1397,13 +1251,16 @@ module Tx_rollup = struct @ optional_arg ~name:"burn-cap" Tez.to_string burn_cap @ optional_arg ~name:"storage-limit" string_of_int storage_limit) in - let parse process = Process.check process in + let parse process = Lwt.bind process Process.check in {value = process; run = parse} - let submit_finalize_commitment ?(wait = "none") ?burn_cap ?storage_limit - ?hooks ~rollup ~src client = + let submit_finalize_commitment ?monitor_mempool ?endpoint ?(wait = "none") + ?burn_cap ?storage_limit ?hooks ~rollup ~src client = let process = + check_injection_process ?monitor_mempool ?endpoint client + @@ fun ?endpoint client -> spawn_command + ?endpoint ?hooks client (["--wait"; wait] @@ -1411,13 +1268,16 @@ module Tx_rollup = struct @ optional_arg ~name:"burn-cap" Tez.to_string burn_cap @ optional_arg ~name:"storage-limit" string_of_int storage_limit) in - let parse process = Process.check process in + let parse process = Lwt.bind process Process.check in {value = process; run = parse} - let submit_remove_commitment ?(wait = "none") ?burn_cap ?storage_limit ?hooks - ~rollup ~src client = + let submit_remove_commitment ?monitor_mempool ?endpoint ?(wait = "none") + ?burn_cap ?storage_limit ?hooks ~rollup ~src client = let process = + check_injection_process ?monitor_mempool ?endpoint client + @@ fun ?endpoint client -> spawn_command + ?endpoint ?hooks client (["--wait"; wait] @@ -1425,15 +1285,18 @@ module Tx_rollup = struct @ optional_arg ~name:"burn-cap" Tez.to_string burn_cap @ optional_arg ~name:"storage-limit" string_of_int storage_limit) in - let parse process = Process.check process in + let parse process = Lwt.bind process Process.check in {value = process; run = parse} - let submit_rejection ?(wait = "none") ?burn_cap ?storage_limit ?hooks ~level - ~message ~position ~path ~message_result_hash + let submit_rejection ?monitor_mempool ?endpoint ?(wait = "none") ?burn_cap + ?storage_limit ?hooks ~level ~message ~position ~path ~message_result_hash ~rejected_message_result_path ~agreed_message_result_path ~proof ~context_hash ~withdraw_list_hash ~rollup ~src client = let process = + check_injection_process ?monitor_mempool ?endpoint client + @@ fun ?endpoint client -> spawn_command + ?endpoint ?hooks client (["--wait"; wait] @@ -1451,13 +1314,16 @@ module Tx_rollup = struct @ optional_arg ~name:"burn-cap" Tez.to_string burn_cap @ optional_arg ~name:"storage-limit" string_of_int storage_limit) in - let parse process = Process.check process in + let parse process = Lwt.bind process Process.check in {value = process; run = parse} - let submit_return_bond ?(wait = "none") ?burn_cap ?storage_limit ?hooks - ~rollup ~src client = + let submit_return_bond ?monitor_mempool ?endpoint ?(wait = "none") ?burn_cap + ?storage_limit ?hooks ~rollup ~src client = let process = + check_injection_process ?monitor_mempool ?endpoint client + @@ fun ?endpoint client -> spawn_command + ?endpoint ?hooks client (["--wait"; wait] @@ -1471,14 +1337,18 @@ module Tx_rollup = struct ~some:(fun s -> ["--storage-limit"; string_of_int s]) storage_limit) in - let parse process = Process.check process in + let parse process = Lwt.bind process Process.check in {value = process; run = parse} - let dispatch_tickets ?(wait = "none") ?burn_cap ?storage_limit ?hooks - ~tx_rollup ~src ~level ~message_position ~context_hash - ~message_result_path ~ticket_dispatch_info_data_list client = + let dispatch_tickets ?monitor_mempool ?endpoint ?(wait = "none") ?burn_cap + ?storage_limit ?hooks ~tx_rollup ~src ~level ~message_position + ~context_hash ~message_result_path ~ticket_dispatch_info_data_list client + = let process = + check_injection_process ?monitor_mempool ?endpoint client + @@ fun ?endpoint client -> spawn_command + ?endpoint ?hooks client (["--wait"; wait] @@ -1516,13 +1386,16 @@ module Tx_rollup = struct @ optional_arg ~name:"burn-cap" Tez.to_string burn_cap @ optional_arg ~name:"storage-limit" string_of_int storage_limit) in - let parse process = Process.check process in + let parse process = Lwt.bind process Process.check in {value = process; run = parse} - let transfer_tickets ?(wait = "none") ?burn_cap ?hooks ~qty ~src ~destination - ~entrypoint ~contents ~ty ~ticketer client = + let transfer_tickets ?monitor_mempool ?endpoint ?(wait = "none") ?burn_cap + ?hooks ~qty ~src ~destination ~entrypoint ~contents ~ty ~ticketer client = let process = + check_injection_process ?monitor_mempool ?endpoint client + @@ fun ?endpoint client -> spawn_command + ?endpoint ?hooks client (["--wait"; wait] @@ -1549,7 +1422,7 @@ module Tx_rollup = struct ] @ optional_arg ~name:"burn-cap" Tez.to_string burn_cap) in - let parse process = Process.check process in + let parse process = Lwt.bind process Process.check in {value = process; run = parse} end @@ -1567,9 +1440,10 @@ let show_voting_period ?endpoint client = | Some period -> return period module Sc_rollup = struct - let spawn_originate ?hooks ?(wait = "none") ?burn_cap ~src ~kind ~boot_sector - client = + let spawn_originate ?endpoint ?hooks ?(wait = "none") ?burn_cap ~src ~kind + ~boot_sector client = spawn_command + ?endpoint ?hooks client (["--wait"; wait] @@ -1593,49 +1467,50 @@ module Sc_rollup = struct | None -> Test.fail "Cannot extract rollup address from receipt." | Some x -> return x - let originate ?hooks ?wait ?burn_cap ~src ~kind ~boot_sector client = - let process = - spawn_originate ?hooks ?wait ?burn_cap ~src ~kind ~boot_sector client + let originate ?monitor_mempool ?endpoint ?hooks ?wait ?burn_cap ~src ~kind + ~boot_sector client = + let* output = + check_injection_output ?monitor_mempool ?endpoint client + @@ spawn_originate ?hooks ?wait ?burn_cap ~src ~kind ~boot_sector in - let* output = Process.check_and_read_stdout process in parse_rollup_address_in_receipt output - let spawn_send_message ?hooks ?(wait = "none") ?burn_cap ~msg ~src ~dst client - = + let spawn_send_message ?endpoint ?hooks ?(wait = "none") ?burn_cap ~msg ~src + ~dst client = spawn_command + ?endpoint ?hooks client (["--wait"; wait] @ ["send"; "sc"; "rollup"; "message"; msg; "from"; src; "to"; dst] @ optional_arg ~name:"burn-cap" Tez.to_string burn_cap) - let send_message ?hooks ?wait ?burn_cap ~msg ~src ~dst client = - let process = - spawn_send_message ?hooks ?wait ?burn_cap ~msg ~src ~dst client - in - Process.check process + let send_message ?monitor_mempool ?endpoint ?hooks ?wait ?burn_cap ~msg ~src + ~dst client = + check_injection ?monitor_mempool ?endpoint client + @@ spawn_send_message ?hooks ?wait ?burn_cap ~msg ~src ~dst - let spawn_cement_commitment ?hooks ?(wait = "none") ?burn_cap ~hash ~src ~dst - client = + let spawn_cement_commitment ?endpoint ?hooks ?(wait = "none") ?burn_cap ~hash + ~src ~dst client = spawn_command + ?endpoint ?hooks client (["--wait"; wait] @ ["cement"; "commitment"; hash; "from"; src; "for"; "sc"; "rollup"; dst] @ optional_arg ~name:"burn-cap" Tez.to_string burn_cap) - let cement_commitment ?hooks ?wait ?burn_cap ~hash ~src ~dst client = - let process = - spawn_cement_commitment ?hooks ?wait ?burn_cap ~hash ~src ~dst client - in - Process.check process + let cement_commitment ?monitor_mempool ?endpoint ?hooks ?wait ?burn_cap ~hash + ~src ~dst client = + check_injection ?monitor_mempool ?endpoint client + @@ spawn_cement_commitment ?hooks ?wait ?burn_cap ~hash ~src ~dst end let init ?path ?admin_path ?name ?color ?base_dir ?endpoint ?media_type () = let client = create ?path ?admin_path ?name ?color ?base_dir ?endpoint ?media_type () in - Account.write Constant.all_secret_keys ~base_dir:client.base_dir ; + Account.write Constant.all_secret_keys ~base_dir:(Client_base.base_dir client) ; return client let init_mockup ?path ?admin_path ?name ?color ?base_dir ?sync_mode @@ -1662,19 +1537,6 @@ let init_mockup ?path ?admin_path ?name ?color ?base_dir ?sync_mode set_mode Mockup client ; return client -let write_sources_file ~min_agreement ~uris client = - (* Create a services.json file in the base directory with correctly - JSONified data *) - Lwt_io.with_file ~mode:Lwt_io.Output (sources_file client) (fun oc -> - let obj = - `O - [ - ("min_agreement", `Float min_agreement); - ("uris", `A (List.map (fun s -> `String s) uris)); - ] - in - Lwt_io.fprintf oc "%s" @@ Ezjsonm.value_to_string obj) - let init_light ?path ?admin_path ?name ?color ?base_dir ?(min_agreement = 0.66) ?event_level ?event_sections_levels ?(nodes_args = []) () = let filter_node_arg = function @@ -1713,7 +1575,7 @@ let init_light ?path ?admin_path ?name ?color ?base_dir ?(min_agreement = 0.66) let json = JSON.parse_file (sources_file client) in Log.info "%s" @@ JSON.encode json ; Log.info "Importing keys" ; - Account.write Constant.all_secret_keys ~base_dir:client.base_dir ; + Account.write Constant.all_secret_keys ~base_dir:(Client_base.base_dir client) ; Log.info "Syncing peers" ; let* () = assert (nodes <> []) ; @@ -1743,7 +1605,7 @@ let stresstest_gen_keys ?endpoint n client = {alias; public_key_hash; public_key; secret_key} in let additional_bootstraps = List.mapi read_one (JSON.as_list json) in - client.additional_bootstraps <- additional_bootstraps ; + set_additional_bootstraps client additional_bootstraps ; Lwt.return additional_bootstraps let get_parameter_file ?additional_bootstrap_accounts ?default_accounts_balance @@ -1784,7 +1646,7 @@ let init_with_node ?path ?admin_path ?name ?color ?base_dir ?event_level let client = create_with_mode ?path ?admin_path ?name ?color ?base_dir mode in - Account.write keys ~base_dir:client.base_dir ; + Account.write keys ~base_dir:(Client_base.base_dir client) ; return (node, client) | `Light -> let* client, node1, _ = diff --git a/tezt/lib_tezos/client.mli b/tezt/lib_tezos/client.mli index 735d5360a6ca58ab00fa713309dc882593da7724..bfac6ce8ab2c65d4e5e37e437f7a0ff459b544d0 100644 --- a/tezt/lib_tezos/client.mli +++ b/tezt/lib_tezos/client.mli @@ -25,15 +25,9 @@ (** Run Tezos client commands. *) -module Time = Tezos_base.Time.System - -(** Values that can be passed to the client's [--endpoint] argument *) -type endpoint = - | Node of Node.t (** A full-fledged node *) - | Proxy_server of Proxy_server.t (** A proxy server *) +include module type of Client_base -(** Values that can be passed to the client's [--media-type] argument *) -type media_type = Json | Binary | Any +module Time = Tezos_base.Time.System (** Values that can be passed to the client's [--timestamp] argument *) type timestamp = Now | Ago of Time.Span.t | At of Time.t @@ -42,191 +36,6 @@ type timestamp = Now | Ago of Time.Span.t | At of Time.t [Time.now ()]. *) val time_of_timestamp : timestamp -> Time.t -(** [rpc_port endpoint] returns the port on which to reach [endpoint] - when doing RPC calls. *) -val rpc_port : endpoint -> int - -(** Mode of the client *) -type mode = - | Client of endpoint option * media_type option - | Mockup - | Light of float * endpoint list - | Proxy of endpoint - -(** [mode_to_endpoint mode] returns the {!endpoint} within a {!mode} - (if any) *) -val mode_to_endpoint : mode -> endpoint option - -(** The synchronization mode of the client. - - - [Asynchronous] mode is when transfer doesn't bake the block. - - [Synchronous] is the default mode (no flag passed to [create mockup]). *) -type mockup_sync_mode = Asynchronous | Synchronous - -(** The mode argument of the client's 'normalize data' command *) -type normalize_mode = Readable | Optimized | Optimized_legacy - -(** Tezos client states. *) -type t - -(** Get the name of a client (e.g. ["client1"]). *) -val name : t -> string - -(** Get the base directory of a client. - - The base directory is the location where clients store their - configuration files. It corresponds to the [--base-dir] option. *) -val base_dir : t -> string - -(** Get [Account.key list] of all extra bootstraps. - - Additional bootstrap accounts are created when you use the - [additional_bootstrap_account_count] argument of [init_with_protocol]. - They do not include the default accounts that are always created. - *) -val additional_bootstraps : t -> Account.key list - -(** Create a client. - - The standard output and standard error output of the node will - be logged with prefix [name] and color [color]. - - Default [base_dir] is a temporary directory - which is always the same for each [name]. - - The endpoint argument is used to know which port the client should connect to. - This endpoint can be overridden for each command, as a client is not actually tied - to an endpoint. Most commands require an endpoint to be specified (either with [create] - or with the command itself). *) -val create : - ?path:string -> - ?admin_path:string -> - ?name:string -> - ?color:Log.Color.t -> - ?base_dir:string -> - ?endpoint:endpoint -> - ?media_type:media_type -> - unit -> - t - -(** Create a client like [create] but do not assume [Client] as the mode. *) -val create_with_mode : - ?path:string -> - ?admin_path:string -> - ?name:string -> - ?color:Log.Color.t -> - ?base_dir:string -> - mode -> - t - -(** Get a client's mode. Used with [set_mode] to temporarily change - a client's mode *) -val get_mode : t -> mode - -(** Change the client's mode. This function is required for example because - we wanna keep a client's wallet. This is impossible if we created - a new client from scratch. *) -val set_mode : mode -> t -> unit - -(** Write the [--sources] file used by the light mode. *) -val write_sources_file : - min_agreement:float -> uris:string list -> t -> unit Lwt.t - -(** {2 RPC calls} *) - -(** Paths for RPCs. - - For instance, [["chains"; "main"; "blocks"; "head"]] - denotes [/chains/main/blocks/head]. *) -type path = string list - -(** [string_of_path ["seg1"; "seg2"]] is ["/seg1/seg2"] *) -val string_of_path : path -> string - -(** Query strings for RPCs. - - For instance, [["key1", "value1"; "key2", "value2"]] - denotes [?key1=value1&key2=value2]. *) -type query_string = (string * string) list - -(** HTTP methods for RPCs. *) -type meth = GET | PUT | POST | PATCH | DELETE - -(** A lowercase string of the method. *) -val string_of_meth : meth -> string - -(** [rpc_path_query_to_string ["key1", "value1"; "key2", "value2")] ["seg1"; "seg2"]] - returns [/seg1/seg2?key1=value1&key2=value2] where seg1, seg2, key1, key2, - value1, and value2 have been appropriately encoded *) -val rpc_path_query_to_string : ?query_string:query_string -> path -> string - -(** Use the client to call an RPC. - - Run [rpc meth path?query_string with data]. - Fail the test if the RPC call failed. - - See the documentation of {!Process.spawn} for information about - [log_*], [hooks] and [env] arguments. - - In particular, [env] can be used to pass [TEZOS_LOG], e.g. - [("TEZOS_LOG", Protocol.daemon_name protocol ^ ".proxy_rpc->debug")] to enable - logging. *) -val rpc : - ?log_command:bool -> - ?log_status_on_exit:bool -> - ?log_output:bool -> - ?better_errors:bool -> - ?endpoint:endpoint -> - ?hooks:Process.hooks -> - ?env:string String_map.t -> - ?data:JSON.u -> - ?query_string:query_string -> - meth -> - path -> - t -> - JSON.t Lwt.t - -(** Same as [rpc], but do not wait for the process to exit. *) -val spawn_rpc : - ?log_command:bool -> - ?log_status_on_exit:bool -> - ?log_output:bool -> - ?better_errors:bool -> - ?endpoint:endpoint -> - ?hooks:Process.hooks -> - ?env:string String_map.t -> - ?data:JSON.u -> - ?query_string:query_string -> - meth -> - path -> - t -> - Process.t - -module Spawn : sig - (* FIXME: This module is temporary and is here to make the new - interface cohabits with the old one. *) - val rpc : - ?log_command:bool -> - ?log_status_on_exit:bool -> - ?log_output:bool -> - ?better_errors:bool -> - ?endpoint:endpoint -> - ?hooks:Process.hooks -> - ?env:string String_map.t -> - ?data:JSON.u -> - ?query_string:query_string -> - meth -> - path -> - t -> - JSON.t Runnable.process -end - -(** Run [tezos-client rpc list]. *) -val rpc_list : ?endpoint:endpoint -> t -> string Lwt.t - -(** Same as [rpc_list], but do not wait for the process to exit. *) -val spawn_rpc_list : ?endpoint:endpoint -> t -> Process.t - (** Run [tezos-client rpc /chains//blocks//header/shell]. *) val shell_header : ?endpoint:endpoint -> ?chain:string -> ?block:string -> t -> string Lwt.t @@ -402,6 +211,7 @@ val spawn_bake_for : Default [key] is {!Constant.bootstrap1.alias}. *) val endorse_for : + ?monitor_mempool:bool -> ?endpoint:endpoint -> ?protocol:Protocol.t -> ?key:string list -> @@ -422,6 +232,7 @@ val spawn_endorse_for : Default [key] is {!Constant.bootstrap1.alias}. *) val preendorse_for : + ?monitor_mempool:bool -> ?endpoint:endpoint -> ?protocol:Protocol.t -> ?key:string list -> @@ -455,6 +266,7 @@ val spawn_propose_for : (** [propose_for] *) val propose_for : + ?monitor_mempool:bool -> ?endpoint:endpoint -> ?minimal_timestamp:bool -> ?protocol:Protocol.t -> @@ -542,6 +354,7 @@ val bls_import_secret_key : (** Run [tezos-client transfer amount from giver to receiver]. *) val transfer : + ?monitor_mempool:bool -> ?hooks:Process.hooks -> ?log_output:bool -> ?endpoint:endpoint -> @@ -583,6 +396,7 @@ val spawn_transfer : (** Run [tezos-client multiple transfers from giver using json_batch]. *) val multiple_transfers : + ?monitor_mempool:bool -> ?log_output:bool -> ?endpoint:endpoint -> ?wait:string -> @@ -642,7 +456,12 @@ val reveal : (** Run [tezos-client withdraw delegate from ]. *) val withdraw_delegate : - ?endpoint:endpoint -> ?wait:string -> src:string -> t -> unit Lwt.t + ?monitor_mempool:bool -> + ?endpoint:endpoint -> + ?wait:string -> + src:string -> + t -> + unit Lwt.t (** Same as [withdraw_delegate], but do not wait for the process to exit. *) val spawn_withdraw_delegate : @@ -678,6 +497,8 @@ val spawn_create_mockup : Default [key] is {!Constant.bootstrap1.alias}. *) val submit_proposals : + ?monitor_mempool:bool -> + ?endpoint:endpoint -> ?key:string -> ?wait:string -> ?proto_hash:string -> @@ -687,6 +508,7 @@ val submit_proposals : (** Same as [submit_proposals], but do not wait for the process to exit. *) val spawn_submit_proposals : + ?endpoint:endpoint -> ?key:string -> ?wait:string -> ?proto_hash:string -> @@ -700,14 +522,28 @@ type ballot = Nay | Pass | Yay Default [key] is {!Constant.bootstrap1.alias}. *) val submit_ballot : - ?key:string -> ?wait:string -> proto_hash:string -> ballot -> t -> unit Lwt.t + ?monitor_mempool:bool -> + ?endpoint:endpoint -> + ?key:string -> + ?wait:string -> + proto_hash:string -> + ballot -> + t -> + unit Lwt.t (** Same as [submit_ballot], but do not wait for the process to exit. *) val spawn_submit_ballot : - ?key:string -> ?wait:string -> proto_hash:string -> ballot -> t -> Process.t + ?endpoint:endpoint -> + ?key:string -> + ?wait:string -> + proto_hash:string -> + vote:ballot -> + t -> + Process.t (** Run [tezos-client set deposits limit for to ] *) val set_deposits_limit : + ?monitor_mempool:bool -> ?hooks:Process.hooks -> ?endpoint:endpoint -> ?wait:string -> @@ -718,6 +554,7 @@ val set_deposits_limit : (** Run [tezos-client unset deposits limit for ] *) val unset_deposits_limit : + ?monitor_mempool:bool -> ?hooks:Process.hooks -> ?endpoint:endpoint -> ?wait:string -> @@ -733,6 +570,7 @@ val unset_deposits_limit : (** Run [tezos-client originate contract alias transferring amount from src running prg]. Returns the originated contract hash *) val originate_contract : + ?monitor_mempool:bool -> ?hooks:Process.hooks -> ?log_output:bool -> ?endpoint:endpoint -> @@ -889,6 +727,8 @@ val spawn_run_script : (** Run [tezos-client register global constant value from src]. Returns the address hash of the new constant. *) val register_global_constant : + ?monitor_mempool:bool -> + ?endpoint:endpoint -> ?wait:string -> ?burn_cap:Tez.t -> src:string -> @@ -898,6 +738,7 @@ val register_global_constant : (** Same as [register_global_constant] but do not wait for the process to exit. *) val spawn_register_global_constant : + ?endpoint:endpoint -> ?wait:string -> ?burn_cap:Tez.t -> value:string -> @@ -1047,6 +888,8 @@ val spawn_sign_block : t -> string -> delegate:string -> Process.t module Tx_rollup : sig (** Run [tezos-client originate tx rollup from ]. *) val originate : + ?monitor_mempool:bool -> + ?endpoint:endpoint -> ?wait:string -> ?burn_cap:Tez.t -> ?storage_limit:int -> @@ -1054,10 +897,12 @@ module Tx_rollup : sig ?hooks:Process.hooks -> src:string -> t -> - string Runnable.process + string Lwt.t (** Run [tezos-client submit tx rollup batch to from ]. *) val submit_batch : + ?monitor_mempool:bool -> + ?endpoint:endpoint -> ?wait:string -> ?burn_cap:Tez.t -> ?storage_limit:int -> @@ -1068,10 +913,12 @@ module Tx_rollup : sig rollup:string -> src:string -> t -> - unit Runnable.process + (Process.t Lwt.t, unit) Runnable.t (** Run [tezos-client submit tx rollup commitment to from ]. *) val submit_commitment : + ?monitor_mempool:bool -> + ?endpoint:endpoint -> ?wait:string -> ?burn_cap:Tez.t -> ?storage_limit:int -> @@ -1083,10 +930,12 @@ module Tx_rollup : sig rollup:string -> src:string -> t -> - unit Runnable.process + (Process.t Lwt.t, unit) Runnable.t (** Run [tezos-client submit tx rollup finalize commitment to from ]. *) val submit_finalize_commitment : + ?monitor_mempool:bool -> + ?endpoint:endpoint -> ?wait:string -> ?burn_cap:Tez.t -> ?storage_limit:int -> @@ -1094,10 +943,12 @@ module Tx_rollup : sig rollup:string -> src:string -> t -> - unit Runnable.process + (Process.t Lwt.t, unit) Runnable.t (** Run [tezos-client submit tx rollup remove commitment to from ]. *) val submit_remove_commitment : + ?monitor_mempool:bool -> + ?endpoint:endpoint -> ?wait:string -> ?burn_cap:Tez.t -> ?storage_limit:int -> @@ -1105,13 +956,15 @@ module Tx_rollup : sig rollup:string -> src:string -> t -> - unit Runnable.process + (Process.t Lwt.t, unit) Runnable.t (** Run [tezos-client submit tx rollup rejection commitment at level message at with with agreed context hash and withdraw list to from ]. *) val submit_rejection : + ?monitor_mempool:bool -> + ?endpoint:endpoint -> ?wait:string -> ?burn_cap:Tez.t -> ?storage_limit:int -> @@ -1129,10 +982,12 @@ module Tx_rollup : sig rollup:string -> src:string -> t -> - unit Runnable.process + (Process.t Lwt.t, unit) Runnable.t (** Run [tezos-client submit tx rollup return bond to from ]. *) val submit_return_bond : + ?monitor_mempool:bool -> + ?endpoint:endpoint -> ?wait:string -> ?burn_cap:Tez.t -> ?storage_limit:int -> @@ -1140,9 +995,11 @@ module Tx_rollup : sig rollup:string -> src:string -> t -> - unit Runnable.process + (Process.t Lwt.t, unit) Runnable.t val dispatch_tickets : + ?monitor_mempool:bool -> + ?endpoint:endpoint -> ?wait:string -> ?burn_cap:Tez.t -> ?storage_limit:int -> @@ -1155,9 +1012,11 @@ module Tx_rollup : sig message_result_path:string -> ticket_dispatch_info_data_list:string list -> t -> - unit Runnable.process + (Process.t Lwt.t, unit) Runnable.t val transfer_tickets : + ?monitor_mempool:bool -> + ?endpoint:endpoint -> ?wait:string -> ?burn_cap:Tez.t -> ?hooks:Process.hooks -> @@ -1169,7 +1028,7 @@ module Tx_rollup : sig ty:string -> ticketer:string -> t -> - unit Runnable.process + (Process.t Lwt.t, unit) Runnable.t end (** Run [tezos-client show voting period] and return the period name. *) @@ -1181,6 +1040,8 @@ val spawn_show_voting_period : ?endpoint:endpoint -> t -> Process.t module Sc_rollup : sig (** Run [tezos-client originate sc rollup from of kind booting with ]. *) val originate : + ?monitor_mempool:bool -> + ?endpoint:endpoint -> ?hooks:Process.hooks -> ?wait:string -> ?burn_cap:Tez.t -> @@ -1192,6 +1053,7 @@ module Sc_rollup : sig (** Same as [originate], but do not wait for the process to exit. *) val spawn_originate : + ?endpoint:endpoint -> ?hooks:Process.hooks -> ?wait:string -> ?burn_cap:Tez.t -> @@ -1203,6 +1065,8 @@ module Sc_rollup : sig (** Run [tezos-client send rollup message from to ]. *) val send_message : + ?monitor_mempool:bool -> + ?endpoint:endpoint -> ?hooks:Process.hooks -> ?wait:string -> ?burn_cap:Tez.t -> @@ -1214,6 +1078,7 @@ module Sc_rollup : sig (** Same as [send_message], but do not wait for the process to exit. *) val spawn_send_message : + ?endpoint:endpoint -> ?hooks:Process.hooks -> ?wait:string -> ?burn_cap:Tez.t -> @@ -1225,6 +1090,8 @@ module Sc_rollup : sig (** Run [tezos-client cemment commitment from for sc rollup ]. *) val cement_commitment : + ?monitor_mempool:bool -> + ?endpoint:endpoint -> ?hooks:Process.hooks -> ?wait:string -> ?burn_cap:Tez.t -> @@ -1236,6 +1103,7 @@ module Sc_rollup : sig (** Same as [cement_commitment], but do not wait for the process to exit. *) val spawn_cement_commitment : + ?endpoint:endpoint -> ?hooks:Process.hooks -> ?wait:string -> ?burn_cap:Tez.t -> @@ -1248,19 +1116,6 @@ end (** {2 High-Level Functions} *) -(** Create a client with mode [Client] and import all secret keys - listed in {!Constant.all_secret_keys}. *) -val init : - ?path:string -> - ?admin_path:string -> - ?name:string -> - ?color:Log.Color.t -> - ?base_dir:string -> - ?endpoint:endpoint -> - ?media_type:media_type -> - unit -> - t Lwt.t - (** Set up a client and node(s). - Create a client with mode [Client], [Light], or [Proxy]. @@ -1353,25 +1208,6 @@ val init_light : unit -> (t * Node.t * Node.t) Lwt.t -(** Spawn a low-level client command. - - Prefer using higher-level functions defined in this module, or adding a new - one, to deferring to [spawn_command]. - - It can be used, for example, for low-level one-shot customization of client - commands. *) -val spawn_command : - ?log_command:bool -> - ?log_status_on_exit:bool -> - ?log_output:bool -> - ?env:string String_map.t -> - ?endpoint:endpoint -> - ?hooks:Process.hooks -> - ?admin:bool -> - t -> - string list -> - Process.t - (** Register public key for given account with given client. *) val spawn_register_key : string -> t -> Process.t diff --git a/tezt/lib_tezos/client_base.ml b/tezt/lib_tezos/client_base.ml new file mode 100644 index 0000000000000000000000000000000000000000..80e2f79f1b1ade8f51a1dad57c0481d2f9c08fbf --- /dev/null +++ b/tezt/lib_tezos/client_base.ml @@ -0,0 +1,369 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Runnable.Syntax + +type endpoint = Node of Node.t | Proxy_server of Proxy_server.t + +type media_type = Json | Binary | Any + +let rpc_port = function + | Node n -> Node.rpc_port n + | Proxy_server ps -> Proxy_server.rpc_port ps + +type mode = + | Client of endpoint option * media_type option + | Mockup + | Light of float * endpoint list + | Proxy of endpoint + +type mockup_sync_mode = Asynchronous | Synchronous + +type normalize_mode = Readable | Optimized | Optimized_legacy + +type t = { + path : string; + admin_path : string; + name : string; + color : Log.Color.t; + base_dir : string; + mutable additional_bootstraps : Account.key list; + mutable mode : mode; +} + +let name t = t.name + +let base_dir t = t.base_dir + +let additional_bootstraps t = t.additional_bootstraps + +let get_mode t = t.mode + +let set_mode mode t = t.mode <- mode + +let next_name = ref 1 + +let fresh_name () = + let index = !next_name in + incr next_name ; + "client" ^ string_of_int index + +let () = Test.declare_reset_function @@ fun () -> next_name := 1 + +let runner endpoint = + match endpoint with + | Node node -> Node.runner node + | Proxy_server ps -> Proxy_server.runner ps + +let address ?(hostname = false) ?from peer = + match from with + | None -> Runner.address ~hostname (runner peer) + | Some endpoint -> + Runner.address ~hostname ?from:(runner endpoint) (runner peer) + +let set_additional_bootstraps client additional_bootstraps = + client.additional_bootstraps <- additional_bootstraps + +let create_with_mode ?(path = Constant.tezos_client) + ?(admin_path = Constant.tezos_admin_client) ?name + ?(color = Log.Color.FG.blue) ?base_dir mode = + let name = match name with None -> fresh_name () | Some name -> name in + let base_dir = + match base_dir with None -> Temp.dir name | Some dir -> dir + in + let additional_bootstraps = [] in + {path; admin_path; name; color; base_dir; additional_bootstraps; mode} + +let create ?path ?admin_path ?name ?color ?base_dir ?endpoint ?media_type () = + create_with_mode + ?path + ?admin_path + ?name + ?color + ?base_dir + (Client (endpoint, media_type)) + +let base_dir_arg client = ["--base-dir"; client.base_dir] + +(* To avoid repeating unduly the sources file name, we create a function here + to get said file name as string. + Do not call it from a client in Mockup or Client (nominal) mode. *) +let sources_file client = + match client.mode with + | Mockup | Client _ | Proxy _ -> assert false + | Light _ -> client.base_dir // "sources.json" + +let mode_to_endpoint = function + | Client (None, _) | Mockup | Light (_, []) -> None + | Client (Some endpoint, _) | Light (_, endpoint :: _) | Proxy endpoint -> + Some endpoint + +(* [?endpoint] can be used to override the default node stored in the client. + Mockup nodes do not use [--endpoint] at all: RPCs are mocked up. + Light mode needs a file (specified with [--sources] on the CLI) + that contains a list of endpoints. +*) +let endpoint_arg ?(endpoint : endpoint option) client = + let either o1 o2 = match (o1, o2) with Some _, _ -> o1 | _ -> o2 in + (* pass [?endpoint] first: it has precedence over client.mode *) + match either endpoint (mode_to_endpoint client.mode) with + | None -> [] + | Some e -> + ["--endpoint"; sf "http://%s:%d" (address ~hostname:true e) (rpc_port e)] + +let media_type_arg client = + match client with + | Client (_, Some media_type) -> ( + match media_type with + | Json -> ["--media-type"; "json"] + | Binary -> ["--media-type"; "binary"] + | Any -> ["--media-type"; "any"]) + | _ -> [] + +let mode_arg client = + match client.mode with + | Client _ -> [] + | Mockup -> ["--mode"; "mockup"] + | Light _ -> ["--mode"; "light"; "--sources"; sources_file client] + | Proxy _ -> ["--mode"; "proxy"] + +let write_sources_file ~min_agreement ~uris client = + (* Create a services.json file in the base directory with correctly + JSONified data *) + Lwt_io.with_file ~mode:Lwt_io.Output (sources_file client) (fun oc -> + let obj = + `O + [ + ("min_agreement", `Float min_agreement); + ("uris", `A (List.map (fun s -> `String s) uris)); + ] + in + Lwt_io.fprintf oc "%s" @@ Ezjsonm.value_to_string obj) + +let init ?path ?admin_path ?name ?color ?base_dir ?endpoint ?media_type () = + let client = + create ?path ?admin_path ?name ?color ?base_dir ?endpoint ?media_type () + in + Account.write Constant.all_secret_keys ~base_dir:client.base_dir ; + return client + +let spawn_command ?log_command ?log_status_on_exit ?log_output + ?(env = String_map.empty) ?endpoint ?hooks ?(admin = false) client command = + let env = + (* Set disclaimer to "Y" if unspecified, otherwise use given value *) + String_map.update + "TEZOS_CLIENT_UNSAFE_DISABLE_DISCLAIMER" + (fun o -> Option.value ~default:"Y" o |> Option.some) + env + in + Process.spawn + ~name:client.name + ~color:client.color + ~env + ?log_command + ?log_status_on_exit + ?log_output + ?hooks + (if admin then client.admin_path else client.path) + @@ endpoint_arg ?endpoint client + @ media_type_arg client.mode @ mode_arg client @ base_dir_arg client @ command + +let url_encode str = + let buffer = Buffer.create (String.length str * 3) in + for i = 0 to String.length str - 1 do + match str.[i] with + | ('a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '.' | '_' | '-' | '/') as c -> + Buffer.add_char buffer c + | c -> + Buffer.add_char buffer '%' ; + let c1, c2 = Hex.of_char c in + Buffer.add_char buffer c1 ; + Buffer.add_char buffer c2 + done ; + let result = Buffer.contents buffer in + Buffer.reset buffer ; + result + +type meth = GET | PUT | POST | PATCH | DELETE + +let string_of_meth = function + | GET -> "get" + | PUT -> "put" + | POST -> "post" + | PATCH -> "patch" + | DELETE -> "delete" + +type path = string list + +let string_of_path path = "/" ^ String.concat "/" (List.map url_encode path) + +type query_string = (string * string) list + +let string_of_query_string = function + | [] -> "" + | qs -> + let qs' = List.map (fun (k, v) -> (url_encode k, url_encode v)) qs in + "?" ^ String.concat "&" @@ List.map (fun (k, v) -> k ^ "=" ^ v) qs' + +let rpc_path_query_to_string ?(query_string = []) path = + string_of_path path ^ string_of_query_string query_string + +module Spawn = struct + let rpc ?log_command ?log_status_on_exit ?log_output ?(better_errors = false) + ?endpoint ?hooks ?env ?data ?query_string meth path client : + JSON.t Runnable.process = + let process = + let data = + Option.fold ~none:[] ~some:(fun x -> ["with"; JSON.encode_u x]) data + in + let query_string = + Option.fold ~none:"" ~some:string_of_query_string query_string + in + let path = string_of_path path in + let full_path = path ^ query_string in + let better_error = if better_errors then ["--better-errors"] else [] in + spawn_command + ?log_command + ?log_status_on_exit + ?log_output + ?endpoint + ?hooks + ?env + client + (better_error @ ["rpc"; string_of_meth meth; full_path] @ data) + in + let parse process = + let* output = Process.check_and_read_stdout process in + return (JSON.parse ~origin:(string_of_path path ^ " response") output) + in + {value = process; run = parse} +end + +let spawn_rpc ?log_command ?log_status_on_exit ?log_output ?better_errors + ?endpoint ?hooks ?env ?data ?query_string meth path client = + let*? res = + Spawn.rpc + ?log_command + ?log_status_on_exit + ?log_output + ?better_errors + ?endpoint + ?hooks + ?env + ?data + ?query_string + meth + path + client + in + res + +let rpc ?log_command ?log_status_on_exit ?log_output ?better_errors ?endpoint + ?hooks ?env ?data ?query_string meth path client = + let*! res = + Spawn.rpc + ?log_command + ?log_status_on_exit + ?log_output + ?better_errors + ?endpoint + ?hooks + ?env + ?data + ?query_string + meth + path + client + in + return res + +let spawn_rpc_stream ?log_command ?log_status_on_exit ?log_output ?better_errors + ?endpoint ?hooks ?env ?data ?query_string meth path client = + let*? res = + Spawn.rpc + ?log_command + ?log_status_on_exit + ?log_output + ?better_errors + ?endpoint + ?hooks + ?env + ?data + ?query_string + meth + path + client + in + let line_stream = Lwt_io.read_lines (Process.stdout res) in + let json_stream = + Lwt_stream.map + (fun line -> + Format.eprintf "LINE: %s@." line ; + JSON.parse ~origin:(string_of_path path ^ " response element") line) + line_stream + in + (json_stream, res) + +let rpc_stream ?log_command ?log_status_on_exit ?log_output ?better_errors + ?endpoint ?hooks ?env ?data ?query_string meth path client + (on_value : JSON.t -> [`Continue | `Stop] Lwt.t) = + let stream, process = + spawn_rpc_stream + ?log_command + ?log_status_on_exit + ?log_output + ?better_errors + ?endpoint + ?hooks + ?env + ?data + ?query_string + meth + path + client + in + let rec loop () = + let* json_opt = Lwt_stream.get stream in + match json_opt with + | None -> + (* Stream closes *) + unit + | Some json -> ( + let* res = + Lwt.catch (fun () -> on_value json) (fun _ -> return `Stop) + in + match res with + | `Stop -> + Process.terminate process ; + unit + | `Continue -> loop ()) + in + loop () + +let spawn_rpc_list ?endpoint client = + spawn_command ?endpoint client ["rpc"; "list"] + +let rpc_list ?endpoint client = + spawn_rpc_list ?endpoint client |> Process.check_and_read_stdout diff --git a/tezt/lib_tezos/client_base.mli b/tezt/lib_tezos/client_base.mli new file mode 100644 index 0000000000000000000000000000000000000000..ff5c402e996f1c6da9c3f20b46c3d68fd3d4aff5 --- /dev/null +++ b/tezt/lib_tezos/client_base.mli @@ -0,0 +1,279 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Run Tezos client commands. *) + +(** Values that can be passed to the client's [--endpoint] argument *) +type endpoint = + | Node of Node.t (** A full-fledged node *) + | Proxy_server of Proxy_server.t (** A proxy server *) + +(** Values that can be passed to the client's [--media-type] argument *) +type media_type = Json | Binary | Any + +(** [rpc_port endpoint] returns the port on which to reach [endpoint] + when doing RPC calls. *) +val rpc_port : endpoint -> int + +(** Mode of the client *) +type mode = + | Client of endpoint option * media_type option + | Mockup + | Light of float * endpoint list + | Proxy of endpoint + +(** [mode_to_endpoint mode] returns the {!endpoint} within a {!mode} + (if any) *) +val mode_to_endpoint : mode -> endpoint option + +(** The synchronization mode of the client. + + - [Asynchronous] mode is when transfer doesn't bake the block. + - [Synchronous] is the default mode (no flag passed to [create mockup]). *) +type mockup_sync_mode = Asynchronous | Synchronous + +(** The mode argument of the client's 'normalize data' command *) +type normalize_mode = Readable | Optimized | Optimized_legacy + +(** Tezos client states. *) +type t + +(** Get the name of a client (e.g. ["client1"]). *) +val name : t -> string + +(** Get the base directory of a client. + + The base directory is the location where clients store their + configuration files. It corresponds to the [--base-dir] option. *) +val base_dir : t -> string + +(** Get [Account.key list] of all extra bootstraps. + + Additional bootstrap accounts are created when you use the + [additional_bootstrap_account_count] argument of [init_with_protocol]. + They do not include the default accounts that are always created. + *) +val additional_bootstraps : t -> Account.key list + +(** Create a client. + + The standard output and standard error output of the node will + be logged with prefix [name] and color [color]. + + Default [base_dir] is a temporary directory + which is always the same for each [name]. + + The endpoint argument is used to know which port the client should connect to. + This endpoint can be overridden for each command, as a client is not actually tied + to an endpoint. Most commands require an endpoint to be specified (either with [create] + or with the command itself). *) +val create : + ?path:string -> + ?admin_path:string -> + ?name:string -> + ?color:Log.Color.t -> + ?base_dir:string -> + ?endpoint:endpoint -> + ?media_type:media_type -> + unit -> + t + +(** Create a client like [create] but do not assume [Client] as the mode. *) +val create_with_mode : + ?path:string -> + ?admin_path:string -> + ?name:string -> + ?color:Log.Color.t -> + ?base_dir:string -> + mode -> + t + +(** Create a client with mode [Client] and import all secret keys + listed in {!Constant.all_secret_keys}. *) +val init : + ?path:string -> + ?admin_path:string -> + ?name:string -> + ?color:Log.Color.t -> + ?base_dir:string -> + ?endpoint:endpoint -> + ?media_type:media_type -> + unit -> + t Lwt.t + +(** Get a client's mode. Used with [set_mode] to temporarily change + a client's mode *) +val get_mode : t -> mode + +(** Change the client's mode. This function is required for example because + we wanna keep a client's wallet. This is impossible if we created + a new client from scratch. *) +val set_mode : mode -> t -> unit + +val mode_arg : t -> string list + +(** To avoid repeating unduly the sources file name, this function returns said + file name as string. Do not call it from a client in Mockup or Client + (nominal) mode. *) +val sources_file : t -> string + +(** Write the [--sources] file used by the light mode. *) +val write_sources_file : + min_agreement:float -> uris:string list -> t -> unit Lwt.t + +(** Returns the [address] on which [from] can contact an endpoint. *) +val address : ?hostname:bool -> ?from:endpoint -> endpoint -> string + +val set_additional_bootstraps : t -> Account.key list -> unit + +(** {2 RPC calls} *) + +(** Paths for RPCs. + + For instance, [["chains"; "main"; "blocks"; "head"]] + denotes [/chains/main/blocks/head]. *) +type path = string list + +(** [string_of_path ["seg1"; "seg2"]] is ["/seg1/seg2"] *) +val string_of_path : path -> string + +(** Query strings for RPCs. + + For instance, [["key1", "value1"; "key2", "value2"]] + denotes [?key1=value1&key2=value2]. *) +type query_string = (string * string) list + +(** HTTP methods for RPCs. *) +type meth = GET | PUT | POST | PATCH | DELETE + +(** A lowercase string of the method. *) +val string_of_meth : meth -> string + +(** [rpc_path_query_to_string ["key1", "value1"; "key2", "value2")] ["seg1"; "seg2"]] + returns [/seg1/seg2?key1=value1&key2=value2] where seg1, seg2, key1, key2, + value1, and value2 have been appropriately encoded *) +val rpc_path_query_to_string : ?query_string:query_string -> path -> string + +(** Use the client to call an RPC. + + Run [rpc meth path?query_string with data]. + Fail the test if the RPC call failed. + + See the documentation of {!Process.spawn} for information about + [log_*], [hooks] and [env] arguments. + + In particular, [env] can be used to pass [TEZOS_LOG], e.g. + [("TEZOS_LOG", Protocol.daemon_name protocol ^ ".proxy_rpc->debug")] to enable + logging. *) +val rpc : + ?log_command:bool -> + ?log_status_on_exit:bool -> + ?log_output:bool -> + ?better_errors:bool -> + ?endpoint:endpoint -> + ?hooks:Process.hooks -> + ?env:string String_map.t -> + ?data:JSON.u -> + ?query_string:query_string -> + meth -> + path -> + t -> + JSON.t Lwt.t + +(** Same as [rpc], but do not wait for the process to exit. *) +val spawn_rpc : + ?log_command:bool -> + ?log_status_on_exit:bool -> + ?log_output:bool -> + ?better_errors:bool -> + ?endpoint:endpoint -> + ?hooks:Process.hooks -> + ?env:string String_map.t -> + ?data:JSON.u -> + ?query_string:query_string -> + meth -> + path -> + t -> + Process.t + +module Spawn : sig + (* FIXME: This module is temporary and is here to make the new + interface cohabits with the old one. *) + val rpc : + ?log_command:bool -> + ?log_status_on_exit:bool -> + ?log_output:bool -> + ?better_errors:bool -> + ?endpoint:endpoint -> + ?hooks:Process.hooks -> + ?env:string String_map.t -> + ?data:JSON.u -> + ?query_string:query_string -> + meth -> + path -> + t -> + JSON.t Runnable.process +end + +val rpc_stream : + ?log_command:bool -> + ?log_status_on_exit:bool -> + ?log_output:bool -> + ?better_errors:bool -> + ?endpoint:endpoint -> + ?hooks:Process.hooks -> + ?env:string String_map.t -> + ?data:Ezjsonm.value -> + ?query_string:(string * string) list -> + meth -> + string list -> + t -> + (JSON.t -> [`Continue | `Stop] Lwt.t) -> + unit Lwt.t + +(** Run [tezos-client rpc list]. *) +val rpc_list : ?endpoint:endpoint -> t -> string Lwt.t + +(** Same as [rpc_list], but do not wait for the process to exit. *) +val spawn_rpc_list : ?endpoint:endpoint -> t -> Process.t + +(** Spawn a low-level client command. + + Prefer using higher-level functions defined in this module, or adding a new + one, to deferring to [spawn_command]. + + It can be used, for example, for low-level one-shot customization of client + commands. *) +val spawn_command : + ?log_command:bool -> + ?log_status_on_exit:bool -> + ?log_output:bool -> + ?env:string String_map.t -> + ?endpoint:endpoint -> + ?hooks:Process.hooks -> + ?admin:bool -> + t -> + string list -> + Process.t diff --git a/tezt/lib_tezos/curl.ml b/tezt/lib_tezos/curl.ml new file mode 100644 index 0000000000000000000000000000000000000000..747e790c3ddd5dba98adb5106fc893b5be649ca2 --- /dev/null +++ b/tezt/lib_tezos/curl.ml @@ -0,0 +1,107 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +let curl_path_cache = ref None + +let get () = + Process.( + try + let* curl_path = + match !curl_path_cache with + | Some curl_path -> return curl_path + | None -> + let* curl_path = + run_and_read_stdout "sh" ["-c"; "command -v curl"] + in + let curl_path = String.trim curl_path in + curl_path_cache := Some curl_path ; + return curl_path + in + return + @@ Some + (fun ~url -> + let* output = run_and_read_stdout curl_path ["-s"; url] in + return (JSON.parse ~origin:url output)) + with _ -> return @@ None) + +let post () = + Process.( + try + let* curl_path = + match !curl_path_cache with + | Some curl_path -> return curl_path + | None -> + let* curl_path = + run_and_read_stdout "sh" ["-c"; "command -v curl"] + in + let curl_path = String.trim curl_path in + curl_path_cache := Some curl_path ; + return curl_path + in + return + @@ Some + (fun ~url data -> + let* output = + run_and_read_stdout + curl_path + [ + "-X"; + "POST"; + "-H"; + "Content-Type: application/json"; + "-s"; + url; + "-d"; + JSON.encode data; + ] + in + return (JSON.parse ~origin:url output)) + with _ -> return @@ None) + +let stream () = + let open Process in + try + let* curl_path = + match !curl_path_cache with + | Some curl_path -> return curl_path + | None -> + let* curl_path = run_and_read_stdout "sh" ["-c"; "command -v curl"] in + let curl_path = String.trim curl_path in + curl_path_cache := Some curl_path ; + return curl_path + in + return + @@ Some + (fun ~url -> + let process = spawn curl_path ["-s"; "-N"; url] in + let line_stream = Lwt_io.read_lines (Process.stdout process) in + let json_stream = + Lwt_stream.map + (fun line -> JSON.parse ~origin:url line) + line_stream + in + let close () = Process.terminate process in + (json_stream, close)) + with _ -> return None diff --git a/tezt/lib_tezos/curl.mli b/tezt/lib_tezos/curl.mli new file mode 100644 index 0000000000000000000000000000000000000000..ee72dd62957ee3f823eae77c79d378cc3ca05d43 --- /dev/null +++ b/tezt/lib_tezos/curl.mli @@ -0,0 +1,42 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** [get ()] returns [Some curl] where [curl ~url] returns the raw response + obtained by curl when requesting [url]. Returns [None] if [curl] cannot be + found. *) +val get : unit -> (url:string -> JSON.t Lwt.t) option Lwt.t + +(** [post data] returns [Some curl] where [curl ~url data] returns the raw + response obtained by curl when posting the data to [url]. Returns [None] if + [curl] cannot be found. *) +val post : unit -> (url:string -> JSON.t -> JSON.t Lwt.t) option Lwt.t + +(** [stream ()] returns [Some (f, close)] where [f ~url] returns a stream + containing the JSON items of the response and [close] is a callback function + to close the connection (by terminating the curl process). Note that the + streaming RPC must be produce one JSON value per line. Returns [None] if + [curl] cannot be found. *) +val stream : + unit -> (url:string -> JSON.t Lwt_stream.t * (unit -> unit)) option Lwt.t diff --git a/tezt/lib_tezos/tx_rollup_node.ml b/tezt/lib_tezos/tx_rollup_node.ml index 0573c4522bf2d0026f476e096e401b83dac8b5a9..b1e728d4759ea224e7ae70dcdef04579da9e9063 100644 --- a/tezt/lib_tezos/tx_rollup_node.ml +++ b/tezt/lib_tezos/tx_rollup_node.ml @@ -366,7 +366,7 @@ end module Client = struct let raw_tx_node_rpc node ~url = - let* rpc = RPC.Curl.get () in + let* rpc = Curl.get () in match rpc with | None -> assert false | Some curl -> diff --git a/tezt/tests/sc_rollup.ml b/tezt/tests/sc_rollup.ml index 81d4db547c250b9a63d9d62f7d69bdb72a494410..dde5eb51cc7a390cf00aed26063508e0243076ea 100644 --- a/tezt/tests/sc_rollup.ml +++ b/tezt/tests/sc_rollup.ml @@ -87,7 +87,7 @@ let get_sc_rollup_commitment_frequency_in_blocks client = |> JSON.as_int |> return let sc_rollup_node_rpc sc_node service = - let* curl = RPC.Curl.get () in + let* curl = Curl.get () in match curl with | None -> return None | Some curl -> diff --git a/tezt/tests/tx_rollup.ml b/tezt/tests/tx_rollup.ml index 470b7fb0d1d0c566e1e7348f1b182bc47ff18e7a..fe59df0fe617163d49b4807f34969db556e5f03b 100644 --- a/tezt/tests/tx_rollup.ml +++ b/tezt/tests/tx_rollup.ml @@ -56,7 +56,7 @@ let init_with_tx_rollup ?additional_bootstrap_account_count in (* We originate a dumb rollup to be able to generate a paths for tx_rollups related RPCs. *) - let*! rollup = + let* rollup = Client.Tx_rollup.originate ~hooks ~src:Constant.bootstrap1.public_key_hash @@ -321,6 +321,7 @@ module Regressions = struct let*? p = Client.Tx_rollup.submit_finalize_commitment ~hooks ~rollup ~src client in + let* p = p in let* () = Process.check_error ~msg:(rex "tx_rollup_no_commitment_to_finalize") p in @@ -343,6 +344,7 @@ module Regressions = struct let*? p = submit_remove_commitment ~src:Constant.bootstrap2.public_key_hash state in + let* p = p in let* () = Process.check_error ~msg:(rex "tx_rollup_remove_commitment_too_early") p in @@ -515,6 +517,7 @@ module Regressions = struct ~src:Constant.bootstrap1.public_key_hash state.client in + let* process = process in Process.check_error ~msg: (rex @@ -594,7 +597,7 @@ module Regressions = struct ~src:Constant.bootstrap1.public_key_hash client in - + let* process = process in let* () = Process.check_error ~exit_code:1 @@ -620,6 +623,7 @@ module Regressions = struct in let* () = Client.bake_for_and_wait client in let*? process = submit_finalize_commitment state in + let* process = process in Process.check_error ~exit_code:1 ~msg:(rex "proto.alpha.tx_rollup_no_commitment_to_finalize") @@ -640,6 +644,7 @@ module Regressions = struct let* () = submit_batch ~batch state in let* () = Client.bake_for_and_wait client in let*? process = submit_finalize_commitment state in + let* process = process in Process.check_error ~exit_code:1 ~msg:(rex "proto.alpha.tx_rollup_no_commitment_to_finalize") @@ -662,6 +667,7 @@ module Regressions = struct let* () = submit_batch ~batch state in let* () = Client.bake_for_and_wait client in let*? process = submit_finalize_commitment state in + let* process = process in Process.check_error ~exit_code:1 ~msg:(rex "proto.alpha.tx_rollup_no_commitment_to_finalize") @@ -691,6 +697,7 @@ module Regressions = struct in let* () = Client.bake_for_and_wait client in let*? process = submit_finalize_commitment state in + let* process = process in Process.check_error ~exit_code:1 ~msg:(rex "proto.alpha.tx_rollup_no_commitment_to_finalize") @@ -762,7 +769,7 @@ let test_submit_batches_in_several_blocks = let* node, client = Client.init_with_protocol ~parameter_file `Client ~protocol () in - let*! rollup = + let* rollup = Client.Tx_rollup.originate ~hooks ~src:Constant.bootstrap1.public_key_hash @@ -867,7 +874,7 @@ let test_submit_from_originated_source = in let* () = Client.bake_for_and_wait client in (* We originate a tx_rollup using an implicit account *) - let*! rollup = + let* rollup = Client.Tx_rollup.originate ~src:Constant.bootstrap1.public_key_hash client in let* () = Client.bake_for_and_wait client in @@ -881,6 +888,7 @@ let test_submit_from_originated_source = ~src:originated_contract client in + let* process = process in let* () = Process.check_error ~exit_code:1 @@ -957,6 +965,7 @@ let test_rollup_with_two_commitments = ~error_msg:"The second operation status expected is %R. Got %L" ; (* We try to finalize a new commitment but it fails. *) let*? process = submit_finalize_commitment state in + let* process = process in let* () = Process.check_error ~exit_code:1 @@ -1238,6 +1247,7 @@ let test_rollup_wrong_rejection = ~withdraw_list_hash:Constant.tx_rollup_empty_withdraw_list_hash state in + let* process = process in let* () = Process.check_error ~msg:(rex "proto.alpha.tx_rollup_proof_failed_to_reject") @@ -1296,6 +1306,7 @@ let test_rollup_wrong_path_for_rejection = ~withdraw_list_hash:Constant.tx_rollup_empty_withdraw_list_hash state in + let* process = process in let* () = Process.check_error ~msg:(rex "proto.alpha.tx_rollup_wrong_message_path") @@ -1363,6 +1374,7 @@ let test_rollup_wrong_rejection_long_path = ~withdraw_list_hash:Constant.tx_rollup_empty_withdraw_list_hash state in + let* process = process in let* () = Process.check_error ~msg:(rex "proto.alpha.tx_rollup_wrong_message_path_depth") @@ -1384,6 +1396,7 @@ let test_rollup_wrong_rejection_long_path = ~withdraw_list_hash:Constant.tx_rollup_empty_withdraw_list_hash state in + let* process = process in Process.check_error ~msg:(rex "proto.alpha.tx_rollup_wrong_message_path") process diff --git a/tezt/tests/tx_rollup_node.ml b/tezt/tests/tx_rollup_node.ml index 9675f225451d61050dd04b5378598c8d2503acc2..7cbb359b3a4f5cb952589c2f8313877021c2729f 100644 --- a/tezt/tests/tx_rollup_node.ml +++ b/tezt/tests/tx_rollup_node.ml @@ -227,7 +227,7 @@ let test_node_configuration = in let operator = Constant.bootstrap1.public_key_hash in (* Originate a rollup with a given operator *) - let*! tx_rollup_hash = Client.Tx_rollup.originate ~src:operator client in + let* tx_rollup_hash = Client.Tx_rollup.originate ~src:operator client in let* () = Rollup_node.create Operator ~rollup_id:tx_rollup_hash client node |> Rollup_node.spawn_init_config @@ -263,7 +263,7 @@ let init_and_run_rollup_node ~originator ?operator ?batch_signer ?finalize_commitment_signer ?remove_commitment_signer ?dispatch_withdrawals_signer ?rejection_signer ?(allow_deposit = operator <> None) ?(bake_origination = true) node client = - let*! tx_rollup_hash = Client.Tx_rollup.originate ~src:originator client in + let* tx_rollup_hash = Client.Tx_rollup.originate ~src:originator client in let* () = if bake_origination then Client.bake_for_and_wait client else unit in @@ -317,9 +317,7 @@ let test_not_allow_deposit = in let originator = Constant.bootstrap1.public_key_hash in let operator = Constant.bootstrap2.public_key_hash in - let*! tx_rollup_hash = - Client.Tx_rollup.originate ~src:originator client - in + let* tx_rollup_hash = Client.Tx_rollup.originate ~src:originator client in let* () = Client.bake_for_and_wait client in Log.info "Tx_rollup %s was successfully originated" tx_rollup_hash ; let tx_node = @@ -414,7 +412,7 @@ let test_tx_node_store_inbox = Client.init_with_protocol ~parameter_file `Client ~protocol () in let operator = Constant.bootstrap1.public_key_hash in - let*! rollup = Client.Tx_rollup.originate ~src:operator client in + let* rollup = Client.Tx_rollup.originate ~src:operator client in let* () = Client.bake_for_and_wait client in let tx_node = Rollup_node.create @@ -506,7 +504,7 @@ let test_node_cannot_connect = in let originator = Constant.bootstrap1.public_key_hash in Log.info "Originate rollup" ; - let*! rollup_id = Client.Tx_rollup.originate ~src:originator client in + let* rollup_id = Client.Tx_rollup.originate ~src:originator client in let* () = Client.bake_for_and_wait client in Log.info "Stopping Tezos node" ; let* () = Node.terminate node in @@ -1767,6 +1765,7 @@ let test_l2_proof_rpc_position = ~agreed_message_result_path client in + let* process = process in let* () = Process.check_error ~msg:(rex "proto.alpha.tx_rollup_proof_produced_rejected_state") @@ -1808,6 +1807,7 @@ let test_l2_proof_rpc_position = ~agreed_message_result_path client in + let* process = process in let* () = Process.check_error ~msg:(rex "proto.alpha.tx_rollup_proof_produced_rejected_state") @@ -2682,7 +2682,7 @@ let test_origination_deposit_same_block = contract_id ; let originator = Constant.bootstrap1.public_key_hash in Log.info "Originating rollup" ; - let*! tx_rollup_hash = + let* tx_rollup_hash = Client.Tx_rollup.originate ~fee:(Tez.of_int 100) (* High fee to ensure the origination appears in the block before the