diff --git a/src/client/embedded/alpha/client_proto_alpha.ml b/src/client/embedded/alpha/client_proto_alpha.ml index e4fee2c45..b295966a5 100644 --- a/src/client/embedded/alpha/client_proto_alpha.ml +++ b/src/client/embedded/alpha/client_proto_alpha.ml @@ -13,4 +13,4 @@ module Environment = Tezos_protocol_environment.Make(Raw.Register.Name)() module P = Raw.Functor.Make(Environment) include P -include Updater.WrapProtocol(Raw.Register.Name)(Environment)(P) +include Updater.LiftProtocol(Raw.Register.Name)(Environment)(P) diff --git a/src/client/embedded/alpha/client_proto_contracts.ml b/src/client/embedded/alpha/client_proto_contracts.ml index a5aaeefec..7c3987020 100644 --- a/src/client/embedded/alpha/client_proto_contracts.ml +++ b/src/client/embedded/alpha/client_proto_contracts.ml @@ -15,7 +15,7 @@ module ContractEntity = struct let of_source _ s = match Contract.of_b58check s with | Error _ as err -> - Lwt.return (wrap_error err) + Lwt.return (Environment.wrap_error err) |> trace (failure "bad contract notation") | Ok s -> return s let to_source _ s = return (Contract.to_b58check s) diff --git a/src/client/embedded/alpha/client_proto_programs.ml b/src/client/embedded/alpha/client_proto_programs.ml index 2caa9ed01..2e87a75cb 100644 --- a/src/client/embedded/alpha/client_proto_programs.ml +++ b/src/client/embedded/alpha/client_proto_programs.ml @@ -569,7 +569,7 @@ let report_errors cctxt errs = print_error_trace locations errs in Lwt_list.iter_s (function - | Ecoproto_error errs -> + | Environment.Ecoproto_error errs -> print_error_trace no_locations errs | err -> cctxt.warning "%a" pp_print_error [ err ]) errs @@ -831,12 +831,12 @@ let commands () = let cctxt = Client_commands.make_context (fun _ t -> Buffer.add_string msg t ; Buffer.add_char msg '\n' ; Lwt.return ()) in match errs with - | Ecoproto_error (Script_ir_translator.Ill_formed_type + | Environment.Ecoproto_error (Script_ir_translator.Ill_formed_type (Some ("return" | "parameter" | "storage" as field), _) :: errs) :: _ -> - report_errors cctxt [ Ecoproto_error errs ] >>= fun () -> + report_errors cctxt [ Environment.Ecoproto_error errs ] >>= fun () -> Lwt.return ([], [ List.assoc 0 (List.assoc field program.loc_table), Buffer.contents msg ]) - | Ecoproto_error (Script_ir_translator.Ill_typed_contract (_, _, _, _, type_map) :: errs) :: _ -> - (report_errors cctxt [ Ecoproto_error errs ] >>= fun () -> + | Environment.Ecoproto_error (Script_ir_translator.Ill_typed_contract (_, _, _, _, type_map) :: errs) :: _ -> + (report_errors cctxt [ Environment.Ecoproto_error errs ] >>= fun () -> let (types, _) = emacs_type_map type_map in let loc = match collect_error_locations errs with | hd :: _ -> hd diff --git a/src/client/embedded/alpha/client_proto_rpcs.ml b/src/client/embedded/alpha/client_proto_rpcs.ml index f4d15459e..6db8eac4e 100644 --- a/src/client/embedded/alpha/client_proto_rpcs.ml +++ b/src/client/embedded/alpha/client_proto_rpcs.ml @@ -24,7 +24,7 @@ let call_service1 cctxt s block a1 = (s Node_rpc_services.Blocks.proto_path) block a1 let call_error_service1 cctxt s block a1 = call_service1 cctxt s block a1 >>= function - | Ok (Error _ as err) -> Lwt.return (wrap_error err) + | Ok (Error _ as err) -> Lwt.return (Environment.wrap_error err) | Ok (Ok v) -> return v | Error _ as err -> Lwt.return err let call_service2 cctxt s block a1 a2 = @@ -32,7 +32,7 @@ let call_service2 cctxt s block a1 a2 = (s Node_rpc_services.Blocks.proto_path) block a1 a2 let call_error_service2 cctxt s block a1 a2 = call_service2 cctxt s block a1 a2 >>= function - | Ok (Error _ as err) -> Lwt.return (wrap_error err) + | Ok (Error _ as err) -> Lwt.return (Environment.wrap_error err) | Ok (Ok v) -> return v | Error _ as err -> Lwt.return err diff --git a/src/client/embedded/demo/client_proto_demo.ml b/src/client/embedded/demo/client_proto_demo.ml index 664fba11b..65597ca95 100644 --- a/src/client/embedded/demo/client_proto_demo.ml +++ b/src/client/embedded/demo/client_proto_demo.ml @@ -13,4 +13,4 @@ module Environment = Tezos_protocol_environment.Make(Raw.Register.Name)() module P = Raw.Functor.Make(Environment) include P -include Updater.WrapProtocol(Raw.Register.Name)(Environment)(P) +include Updater.LiftProtocol(Raw.Register.Name)(Environment)(P) diff --git a/src/client/embedded/demo/client_proto_main.ml b/src/client/embedded/demo/client_proto_main.ml index ebf484c43..0fcf2d2f8 100644 --- a/src/client/embedded/demo/client_proto_main.ml +++ b/src/client/embedded/demo/client_proto_main.ml @@ -20,13 +20,13 @@ let demo cctxt = begin cctxt.message "Calling the 'failing' RPC." >>= fun () -> Client_proto_rpcs.failing cctxt.rpc_config block 3 >>= function - | Error [Ecoproto_error [Error.Demo_error 3]] -> + | Error [Environment.Ecoproto_error [Error.Demo_error 3]] -> return () | _ -> failwith "..." end >>=? fun () -> cctxt.message "Direct call to `demo_error`." >>= fun () -> - begin Error.demo_error 101010 >|= wrap_error >>= function - | Error [Ecoproto_error [Error.Demo_error 101010]] -> + begin Error.demo_error 101010 >|= Environment.wrap_error >>= function + | Error [Environment.Ecoproto_error [Error.Demo_error 101010]] -> return () | _ -> failwith "...." end >>=? fun () -> @@ -79,7 +79,7 @@ let commands () = (fixed [ "fail" ]) (fun () _cctxt -> Error.demo_error 101010 - >|= wrap_error) ; + >|= Environment.wrap_error) ; command ~group ~desc: "Mine an empty block" no_options (fixed [ "mine" ]) diff --git a/src/client/embedded/demo/client_proto_rpcs.ml b/src/client/embedded/demo/client_proto_rpcs.ml index 026c7ea2b..486425327 100644 --- a/src/client/embedded/demo/client_proto_rpcs.ml +++ b/src/client/embedded/demo/client_proto_rpcs.ml @@ -12,7 +12,7 @@ let call_service1 cctxt s block a1 = (s Node_rpc_services.Blocks.proto_path) block a1 let call_error_service1 cctxt s block a1 = call_service1 cctxt s block a1 >>= function - | Ok (Error _ as err) -> Lwt.return (wrap_error err) + | Ok (Error _ as err) -> Lwt.return (Environment.wrap_error err) | Ok (Ok v) -> return v | Error _ as err -> Lwt.return err diff --git a/src/client/embedded/genesis/client_proto_genesis.ml b/src/client/embedded/genesis/client_proto_genesis.ml index e0a741d31..c95504614 100644 --- a/src/client/embedded/genesis/client_proto_genesis.ml +++ b/src/client/embedded/genesis/client_proto_genesis.ml @@ -13,4 +13,4 @@ module Environment = Tezos_protocol_environment.Make(Raw.Register.Name)() module P = Raw.Functor.Make(Environment) include P -include Updater.WrapProtocol(Raw.Register.Name)(Environment)(P) +include Updater.LiftProtocol(Raw.Register.Name)(Environment)(P) diff --git a/src/client/embedded/genesis/client_proto_main.ml b/src/client/embedded/genesis/client_proto_main.ml index c0088b497..f059dc2a4 100644 --- a/src/client/embedded/genesis/client_proto_main.ml +++ b/src/client/embedded/genesis/client_proto_main.ml @@ -19,7 +19,7 @@ let call_service1 rpc_config s block a1 = let call_error_service1 rpc_config s block a1 = call_service1 rpc_config s block a1 >>= function - | Ok (Error _ as err) -> Lwt.return (wrap_error err) + | Ok (Error _ as err) -> Lwt.return (Environment.wrap_error err) | Ok (Ok v) -> return v | Error _ as err -> Lwt.return err diff --git a/src/node/shell/state.ml b/src/node/shell/state.ml index fee4d30c0..b3c31cd2e 100644 --- a/src/node/shell/state.ml +++ b/src/node/shell/state.ml @@ -581,8 +581,7 @@ module Registred_protocol = struct module type T = sig val hash: Protocol_hash.t - include Updater.RAW_PROTOCOL with type error := error - and type 'a tzresult := 'a tzresult + include Updater.NODE_PROTOCOL val complete_b58prefix : Context.t -> string -> string list Lwt.t end @@ -596,7 +595,7 @@ module Registred_protocol = struct let hash = hash module P = F(Env) include P - include Updater.WrapProtocol(Name)(Env)(P) + include Updater.LiftProtocol(Name)(Env)(P) let complete_b58prefix = Env.Context.complete end : T) @@ -619,6 +618,36 @@ module Registred_protocol = struct try Some (get_exn hash) with Not_found -> None +end + +module Register_embedded_protocol + (Env : Updater.Node_protocol_environment_sigs.V1) + (Proto : Env.Updater.PROTOCOL) + (Source : sig + val hash: Protocol_hash.t option + val sources: Tezos_data.Protocol.t + end) = struct + + let () = + let hash = + match Source.hash with + | None -> Tezos_data.Protocol.hash Source.sources + | Some hash -> hash in + let module Name = struct + let name = Protocol_hash.to_b58check hash + end in + (* TODO add a memory table for "embedded" sources... *) + Registred_protocol.VersionTable.add + Registred_protocol.versions hash + (module struct + let hash = hash + include Proto + include Updater.LiftProtocol(Name)(Env)(Proto) + let complete_b58prefix = Env.Context.complete + end : Registred_protocol.T) + + + end let read diff --git a/src/node/shell/state.mli b/src/node/shell/state.mli index 6ba940f4e..8859fdb65 100644 --- a/src/node/shell/state.mli +++ b/src/node/shell/state.mli @@ -195,8 +195,7 @@ module Registred_protocol : sig module type T = sig val hash: Protocol_hash.t - include Updater.RAW_PROTOCOL with type error := error - and type 'a tzresult := 'a tzresult + include Updater.NODE_PROTOCOL val complete_b58prefix : Context.t -> string -> string list Lwt.t end @@ -206,3 +205,11 @@ module Registred_protocol : sig val get_exn: Protocol_hash.t -> (module T) end + +module Register_embedded_protocol + (Env : Updater.Node_protocol_environment_sigs.V1) + (Proto : Env.Updater.PROTOCOL) + (Source : sig + val hash: Protocol_hash.t option + val sources: Tezos_data.Protocol.t + end) : sig end diff --git a/src/node/updater/tezos_protocol_environment.ml b/src/node/updater/tezos_protocol_environment.ml index a35300b21..501f83de4 100644 --- a/src/node/updater/tezos_protocol_environment.ml +++ b/src/node/updater/tezos_protocol_environment.ml @@ -280,4 +280,27 @@ module Make(Param : sig val name: string end)() = struct let register_resolver = Base58.register_resolver let complete ctxt s = Base58.complete ctxt s end + + type error += Ecoproto_error of Error_monad.error list + + let () = + let id = Format.asprintf "Ecoproto.%s" Param.name in + register_wrapped_error_kind + (fun ecoerrors -> Error_monad.classify_errors ecoerrors) + ~id ~title:"Error returned by the protocol" + ~description:"Wrapped error for the economic protocol." + ~pp:(fun ppf -> + Format.fprintf ppf + "@[Economic error:@ %a@]" + (Format.pp_print_list Error_monad.pp)) + Data_encoding.(obj1 (req "ecoproto" + (list Error_monad.error_encoding))) + (function Ecoproto_error ecoerrors -> Some ecoerrors + | _ -> None ) + (function ecoerrors -> Ecoproto_error ecoerrors) + + let wrap_error = function + | Ok _ as ok -> ok + | Error errors -> Error [Ecoproto_error errors] + end diff --git a/src/node/updater/updater.ml b/src/node/updater/updater.ml index 73f701d6b..54a14bb5b 100644 --- a/src/node/updater/updater.ml +++ b/src/node/updater/updater.ml @@ -26,47 +26,6 @@ type rpc_context = { context: Context.t ; } -module type RAW_PROTOCOL = sig - type error = .. - type 'a tzresult - type operation - val max_operation_data_length: int - val max_block_length: int - val max_number_of_operations: int - val parse_operation: - Operation_hash.t -> Operation.t -> operation tzresult - val compare_operations: operation -> operation -> int - type validation_state - val current_context: validation_state -> Context.t tzresult Lwt.t - val precheck_block: - ancestor_context: Context.t -> - ancestor_timestamp: Time.t -> - Block_header.t -> - unit tzresult Lwt.t - val begin_application: - predecessor_context: Context.t -> - predecessor_timestamp: Time.t -> - predecessor_fitness: Fitness.t -> - Block_header.t -> - validation_state tzresult Lwt.t - val begin_construction: - predecessor_context: Context.t -> - predecessor_timestamp: Time.t -> - predecessor_level: Int32.t -> - predecessor_fitness: Fitness.t -> - predecessor: Block_hash.t -> - timestamp: Time.t -> - ?proto_header: MBytes.t -> - unit -> validation_state tzresult Lwt.t - val apply_operation: - validation_state -> operation -> validation_state tzresult Lwt.t - val finalize_block: - validation_state -> validation_result tzresult Lwt.t - val rpc_services: rpc_context RPC.directory - val configure_sandbox: - Context.t -> Data_encoding.json option -> Context.t tzresult Lwt.t -end - let activate = Context.set_protocol let fork_test_network = Context.fork_test_network @@ -152,48 +111,94 @@ let compile hash p = Lwt.return loaded end -module type REGISTRED_PROTOCOL = sig - val hash: Protocol_hash.t - include RAW_PROTOCOL with type error := error - and type 'a tzresult := 'a tzresult - val complete_b58prefix : Context.t -> string -> string list Lwt.t +module Node_protocol_environment_sigs = struct + + module type V1 = sig + + include Tezos_protocol_environment_sigs_v1.T + with type Format.formatter = Format.formatter + and type 'a Data_encoding.t = 'a Data_encoding.t + and type 'a Lwt.t = 'a Lwt.t + and type ('a, 'b) Pervasives.result = ('a, 'b) result + and type Hash.Net_id.t = Hash.Net_id.t + and type Hash.Block_hash.t = Hash.Block_hash.t + and type Hash.Operation_hash.t = Hash.Operation_hash.t + and type Hash.Operation_list_list_hash.t = Hash.Operation_list_list_hash.t + and type Context.t = Context.t + and type Time.t = Time.t + and type MBytes.t = MBytes.t + and type Tezos_data.Operation.shell_header = Tezos_data.Operation.shell_header + and type Tezos_data.Operation.t = Tezos_data.Operation.t + and type Tezos_data.Block_header.shell_header = Tezos_data.Block_header.shell_header + and type Tezos_data.Block_header.t = Tezos_data.Block_header.t + and type 'a RPC.directory = 'a RPC.directory + and type Updater.validation_result = validation_result + and type Updater.rpc_context = rpc_context + + type error += Ecoproto_error of Error_monad.error list + val wrap_error : 'a Error_monad.tzresult -> 'a tzresult + + end + end -module WrapProtocol +module type RAW_PROTOCOL = sig + type error = .. + type 'a tzresult = ('a, error list) result + type operation + val max_operation_data_length: int + val max_block_length: int + val max_number_of_operations: int + val parse_operation: + Operation_hash.t -> Operation.t -> operation tzresult + val compare_operations: operation -> operation -> int + type validation_state + val current_context: validation_state -> Context.t tzresult Lwt.t + val precheck_block: + ancestor_context: Context.t -> + ancestor_timestamp: Time.t -> + Block_header.t -> + unit tzresult Lwt.t + val begin_application: + predecessor_context: Context.t -> + predecessor_timestamp: Time.t -> + predecessor_fitness: Fitness.t -> + Block_header.t -> + validation_state tzresult Lwt.t + val begin_construction: + predecessor_context: Context.t -> + predecessor_timestamp: Time.t -> + predecessor_level: Int32.t -> + predecessor_fitness: Fitness.t -> + predecessor: Block_hash.t -> + timestamp: Time.t -> + ?proto_header: MBytes.t -> + unit -> validation_state tzresult Lwt.t + val apply_operation: + validation_state -> operation -> validation_state tzresult Lwt.t + val finalize_block: + validation_state -> validation_result tzresult Lwt.t + val rpc_services: rpc_context RPC.directory + val configure_sandbox: + Context.t -> Data_encoding.json option -> Context.t tzresult Lwt.t +end + +module type NODE_PROTOCOL = + RAW_PROTOCOL with type error := error + and type 'a tzresult := 'a tzresult + + +module LiftProtocol (Name : sig val name: string end) - (Env : Tezos_protocol_environment_sigs_v1.T - with type Format.formatter = Format.formatter - and type 'a Data_encoding.t = 'a Data_encoding.t - and type 'a Lwt.t = 'a Lwt.t - and type ('a, 'b) Pervasives.result = ('a, 'b) Pervasives.result) + (Env : Node_protocol_environment_sigs.V1) (P : Env.Updater.PROTOCOL) = struct - type proto_error = Env.Error_monad.error - type error += Ecoproto_error of proto_error list - let wrap_error = function - | Ok _ as ok -> ok - | Error errors -> Error [Ecoproto_error errors] - let () = - let id = Format.asprintf "Ecoproto.%s" Name.name in - Error_monad.register_wrapped_error_kind - (fun ecoerrors -> Env.Error_monad.classify_errors ecoerrors) - ~id ~title:"Error returned by the protocol" - ~description:"Wrapped error for the economic protocol." - ~pp:(fun ppf -> - Format.fprintf ppf - "@[Economic error:@ %a@]" - (Format.pp_print_list Env.Error_monad.pp)) - Data_encoding.(obj1 (req "ecoproto" - (list Env.Error_monad.error_encoding))) - (function Ecoproto_error ecoerrors -> Some ecoerrors - | _ -> None ) - (function ecoerrors -> Ecoproto_error ecoerrors) include P let precheck_block ~ancestor_context ~ancestor_timestamp raw_block = precheck_block ~ancestor_context ~ancestor_timestamp - raw_block >|= wrap_error + raw_block >|= Env.wrap_error let begin_application ~predecessor_context ~predecessor_timestamp ~predecessor_fitness @@ -201,7 +206,7 @@ module WrapProtocol begin_application ~predecessor_context ~predecessor_timestamp ~predecessor_fitness - raw_block >|= wrap_error + raw_block >|= Env.wrap_error let begin_construction ~predecessor_context ~predecessor_timestamp ~predecessor_level ~predecessor_fitness @@ -209,13 +214,13 @@ module WrapProtocol begin_construction ~predecessor_context ~predecessor_timestamp ~predecessor_level ~predecessor_fitness - ~predecessor ~timestamp ?proto_header () >|= wrap_error + ~predecessor ~timestamp ?proto_header () >|= Env.wrap_error let current_context c = - current_context c >|= wrap_error + current_context c >|= Env.wrap_error let apply_operation c o = - apply_operation c o >|= wrap_error - let finalize_block c = finalize_block c >|= wrap_error - let parse_operation h b = parse_operation h b |> wrap_error + apply_operation c o >|= Env.wrap_error + let finalize_block c = finalize_block c >|= Env.wrap_error + let parse_operation h b = parse_operation h b |> Env.wrap_error let configure_sandbox c j = - configure_sandbox c j >|= wrap_error + configure_sandbox c j >|= Env.wrap_error end diff --git a/src/node/updater/updater.mli b/src/node/updater/updater.mli index b01b2f35b..ec1a2249d 100644 --- a/src/node/updater/updater.mli +++ b/src/node/updater/updater.mli @@ -9,6 +9,14 @@ (* See `src/environment/v1//updater.mli` for documentation. *) +val compile: Protocol_hash.t -> Protocol.t -> bool Lwt.t +val activate: Context.t -> Protocol_hash.t -> Context.t Lwt.t +val fork_test_network: + Context.t -> protocol:Protocol_hash.t -> expiration:Time.t -> Context.t Lwt.t + +val extract: Lwt_io.file_name -> ?hash:Protocol_hash.t -> Protocol.t -> unit Lwt.t +val init: string -> unit + type validation_result = { context: Context.t ; fitness: Fitness.t ; @@ -26,7 +34,7 @@ type rpc_context = { module type RAW_PROTOCOL = sig type error = .. - type 'a tzresult + type 'a tzresult = ('a, error list) result type operation val max_operation_data_length: int val max_block_length: int @@ -65,39 +73,47 @@ module type RAW_PROTOCOL = sig Context.t -> Data_encoding.json option -> Context.t tzresult Lwt.t end -val compile: Protocol_hash.t -> Protocol.t -> bool Lwt.t -val activate: Context.t -> Protocol_hash.t -> Context.t Lwt.t -val fork_test_network: - Context.t -> protocol:Protocol_hash.t -> expiration:Time.t -> Context.t Lwt.t +(**/**) -val extract: Lwt_io.file_name -> ?hash:Protocol_hash.t -> Protocol.t -> unit Lwt.t -val init: string -> unit +(* The end of this file is not exported to the protocol... *) + +module Node_protocol_environment_sigs : sig + + module type V1 = sig + + include Tezos_protocol_environment_sigs_v1.T + with type Format.formatter = Format.formatter + and type 'a Data_encoding.t = 'a Data_encoding.t + and type 'a Lwt.t = 'a Lwt.t + and type ('a, 'b) Pervasives.result = ('a, 'b) result + and type Hash.Net_id.t = Hash.Net_id.t + and type Hash.Block_hash.t = Hash.Block_hash.t + and type Hash.Operation_hash.t = Hash.Operation_hash.t + and type Hash.Operation_list_list_hash.t = Hash.Operation_list_list_hash.t + and type Context.t = Context.t + and type Time.t = Time.t + and type MBytes.t = MBytes.t + and type Tezos_data.Operation.shell_header = Tezos_data.Operation.shell_header + and type Tezos_data.Operation.t = Tezos_data.Operation.t + and type Tezos_data.Block_header.shell_header = Tezos_data.Block_header.shell_header + and type Tezos_data.Block_header.t = Tezos_data.Block_header.t + and type 'a RPC.directory = 'a RPC.directory + and type Updater.validation_result = validation_result + and type Updater.rpc_context = rpc_context + + type error += Ecoproto_error of Error_monad.error list + val wrap_error : 'a Error_monad.tzresult -> 'a tzresult + + end -module WrapProtocol(Name : sig val name: string end) - (Env : Tezos_protocol_environment_sigs_v1.T - with type Format.formatter = Format.formatter - and type 'a Data_encoding.t = 'a Data_encoding.t - and type 'a Lwt.t = 'a Lwt.t - and type ('a, 'b) Pervasives.result = ('a, 'b) result - and type Hash.Net_id.t = Hash.Net_id.t - and type Hash.Block_hash.t = Hash.Block_hash.t - and type Hash.Operation_hash.t = Hash.Operation_hash.t - and type Hash.Operation_list_list_hash.t = Hash.Operation_list_list_hash.t - and type Context.t = Context.t - and type Time.t = Time.t - and type MBytes.t = MBytes.t - and type Tezos_data.Operation.shell_header = Tezos_data.Operation.shell_header - and type Tezos_data.Operation.t = Tezos_data.Operation.t - and type Tezos_data.Block_header.shell_header = Tezos_data.Block_header.shell_header - and type Tezos_data.Block_header.t = Tezos_data.Block_header.t - and type 'a RPC.directory = 'a RPC.directory - and type Updater.validation_result = validation_result - and type Updater.rpc_context = rpc_context) - (P : Env.Updater.PROTOCOL) : sig - include RAW_PROTOCOL with type error := error - and type 'a tzresult := 'a tzresult - and type operation := P.operation - and type validation_state := P.validation_state - type error += Ecoproto_error of Env.Error_monad.error list - val wrap_error: 'a Env.Error_monad.tzresult -> 'a tzresult end + +module type NODE_PROTOCOL = + RAW_PROTOCOL with type error := error + and type 'a tzresult := 'a tzresult + +module LiftProtocol(Name : sig val name: string end) + (Env : Node_protocol_environment_sigs.V1) + (P : Env.Updater.PROTOCOL) : + NODE_PROTOCOL with type operation := P.operation + and type validation_state := P.validation_state diff --git a/test/proto_alpha/proto_alpha_helpers.ml b/test/proto_alpha/proto_alpha_helpers.ml index 9499f6bd9..fe4001987 100644 --- a/test/proto_alpha/proto_alpha_helpers.ml +++ b/test/proto_alpha/proto_alpha_helpers.ml @@ -314,7 +314,7 @@ module Assert = struct equal_pkh ~msg actual_delegate expected_delegate let ecoproto_error f = function - | Ecoproto_error errors -> + | Environment.Ecoproto_error errors -> List.exists f errors | _ -> false @@ -429,7 +429,7 @@ module Mining = struct let endorsement_reward block = Client_proto_rpcs.Header.priority rpc_config block >>=? fun prio -> Mining.endorsement_reward ~block_priority:prio >|= - wrap_error >>|? + Environment.wrap_error >>|? Tez.to_cents end diff --git a/test/utils/test_lwt_pipe.ml b/test/utils/test_lwt_pipe.ml index 3756a1483..3b2e01926 100644 --- a/test/utils/test_lwt_pipe.ml +++ b/test/utils/test_lwt_pipe.ml @@ -20,7 +20,7 @@ let rec gen acc f = function | n -> gen (f () :: acc) f (pred n) let run qsize nbp nbc p c = - let q = Lwt_pipe.create qsize in + let q = Lwt_pipe.create ~size:(qsize, fun () -> qsize) () in let producers = gen [] (fun () -> producer q p) nbp in let consumers = gen [] (fun () -> consumer q c) nbc in Lwt.join producers <&> Lwt.join consumers