From fa418ee6e05239664123ca7474f005296818b99a Mon Sep 17 00:00:00 2001 From: Benjamin Canou Date: Wed, 6 Jun 2018 14:45:06 +0200 Subject: [PATCH] Alpha: simplify handling of Unit parameter in Apply --- .../lib_client/michelson_v1_error_reporter.ml | 26 ++++----------- src/proto_alpha/lib_protocol/src/apply.ml | 33 ++++--------------- .../lib_protocol/src/script_interpreter.ml | 19 +++++++++-- .../lib_protocol/src/script_interpreter.mli | 1 + 4 files changed, 31 insertions(+), 48 deletions(-) diff --git a/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml b/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml index ee0287e4c..fbfd6f1f8 100644 --- a/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml +++ b/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml @@ -245,29 +245,17 @@ let report_errors ~details ~show_source ?parsed ppf errs = "@[Storage limit exceeded during typechecking or execution.@,Try again with a higher storage limit.@]" ; if rest <> [] then Format.fprintf ppf "@," ; print_trace locations rest + | [ Alpha_environment.Ecoproto_error (Script_interpreter.Bad_contract_parameter c) ] -> + Format.fprintf ppf + "@[Account %a is not a smart contract, it does not take arguments.@,\ + The `-arg' flag should not be used when transferring to an account.@]" + Contract.pp c | Alpha_environment.Ecoproto_error err :: rest -> begin match err with - | Apply.Bad_contract_parameter (c, None, _) -> + | Script_interpreter.Bad_contract_parameter c -> Format.fprintf ppf - "@[Account %a is not a smart contract, it does not take arguments.@,\ - The `-arg' flag cannot be used when transferring to an account.@]" + "Invalid argument passed to contract %a." Contract.pp c - | Apply.Bad_contract_parameter (c, Some expected, None) -> - Format.fprintf ppf - "@[Contract %a expected an argument of type@, %a@,but no argument was provided.@,\ - The `-arg' flag can be used when transferring to a smart contract.@]" - Contract.pp c - print_expr expected - | Apply.Bad_contract_parameter (c, Some expected, Some argument) -> - let argument = - Option.unopt_exn - (Failure "ill-serialized argument") - (Data_encoding.force_decode argument) in - Format.fprintf ppf - "@[Contract %a expected an argument of type@, %a@,but received@, %a@]" - Contract.pp c - print_expr expected - print_expr argument | Invalid_arity (loc, name, exp, got) -> Format.fprintf ppf "%aprimitive %s expects %d arguments but is given %d." diff --git a/src/proto_alpha/lib_protocol/src/apply.ml b/src/proto_alpha/lib_protocol/src/apply.ml index 6449ecf68..40bdbe4ed 100644 --- a/src/proto_alpha/lib_protocol/src/apply.ml +++ b/src/proto_alpha/lib_protocol/src/apply.ml @@ -14,7 +14,6 @@ open Alpha_context type error += Wrong_voting_period of Voting_period.t * Voting_period.t (* `Temporary *) type error += Wrong_endorsement_predecessor of Block_hash.t * Block_hash.t (* `Temporary *) type error += Duplicate_endorsement of int (* `Branch *) -type error += Bad_contract_parameter of Contract.t * Script.expr option * Script.lazy_expr option (* `Permanent *) type error += Invalid_endorsement_level type error += Invalid_commitment of { expected: bool } type error += Internal_operation_replay of packed_internal_operation @@ -69,20 +68,6 @@ let () = (req "provided" Voting_period.encoding)) (function Wrong_voting_period (e, p) -> Some (e, p) | _ -> None) (fun (e, p) -> Wrong_voting_period (e, p)); - register_error_kind - `Permanent - ~id:"badContractParameter" - ~title:"Contract supplied an invalid parameter" - ~description:"Either no parameter was supplied to a contract, \ - a parameter was passed to an account, \ - or a parameter was supplied of the wrong type" - Data_encoding.(obj3 - (req "contract" Contract.encoding) - (opt "expectedType" Script.expr_encoding) - (opt "providedArgument" Script.lazy_expr_encoding)) - (function Bad_contract_parameter (c, expected, supplied) -> - Some (c, expected, supplied) | _ -> None) - (fun (c, expected, supplied) -> Bad_contract_parameter (c, expected, supplied)) ; register_error_kind `Branch ~id:"operation.duplicate_endorsement" @@ -357,7 +342,7 @@ let apply_manager_operation_content : match Micheline.root arg with | Prim (_, D_Unit, [], _) -> return () - | _ -> fail (Bad_contract_parameter (destination, None, parameters)) + | _ -> fail (Script_interpreter.Bad_contract_parameter destination) end >>=? fun () -> let result = Transaction_result @@ -371,19 +356,13 @@ let apply_manager_operation_content : storage_size_diff = 0L } in return (ctxt, result, []) | Some script -> - Lwt.return (Script.force_decode script.code) >>=? fun code -> - Lwt.return @@ Script_ir_translator.parse_toplevel code >>=? fun (arg_type, _, _) -> - let arg_type = Micheline.strip_locations arg_type in - begin match parameters, Micheline.root arg_type with - | None, Prim (_, T_unit, _, _) -> - return (ctxt, (Micheline.strip_locations (Prim (0, Script.D_Unit, [], None)))) - | Some parameters, _ -> + begin match parameters with + | None -> + let unit = Micheline.strip_locations (Prim (0, Script.D_Unit, [], None)) in + return (ctxt, unit) + | Some parameters -> Lwt.return (Script.force_decode parameters) >>=? fun arg -> - trace - (Bad_contract_parameter (destination, Some arg_type, Some parameters)) - (Script_ir_translator.typecheck_data ctxt (arg, arg_type)) >>=? fun ctxt -> return (ctxt, arg) - | None, _ -> fail (Bad_contract_parameter (destination, Some arg_type, None)) end >>=? fun (ctxt, parameter) -> Script_interpreter.execute ctxt mode diff --git a/src/proto_alpha/lib_protocol/src/script_interpreter.ml b/src/proto_alpha/lib_protocol/src/script_interpreter.ml index 74e2fd6de..0f7c7a6e8 100644 --- a/src/proto_alpha/lib_protocol/src/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/src/script_interpreter.ml @@ -17,6 +17,7 @@ open Script_ir_translator type error += Reject of Script.location type error += Overflow of Script.location type error += Runtime_contract_error : Contract.t * Script.expr -> error +type error += Bad_contract_parameter of Contract.t (* `Permanent *) let () = let open Data_encoding in @@ -52,7 +53,19 @@ let () = Some (contract, expr) | _ -> None) (fun (contract, expr) -> - Runtime_contract_error (contract, expr)) + Runtime_contract_error (contract, expr)) ; + (* Bad contract parameter *) + register_error_kind + `Permanent + ~id:"badContractParameter" + ~title:"Contract supplied an invalid parameter" + ~description:"Either no parameter was supplied to a contract with \ + a non-unit parameter type, a non-unit parameter was \ + passed to an account, or a parameter was supplied of \ + the wrong type" + Data_encoding.(obj1 (req "contract" Contract.encoding)) + (function Bad_contract_parameter c -> Some c | _ -> None) + (fun c -> Bad_contract_parameter c) (* ---- interpreter ---------------------------------------------------------*) @@ -697,7 +710,9 @@ and execute ?log ctxt mode ~source ~payer ~self script amount arg : Script_typed_ir.ex_big_map option) tzresult Lwt.t = parse_script ctxt script >>=? fun ((Ex_script { code ; arg_type ; storage ; storage_type }), ctxt) -> - parse_data ctxt arg_type arg >>=? fun (arg, ctxt) -> + trace + (Bad_contract_parameter self) + (parse_data ctxt arg_type arg) >>=? fun (arg, ctxt) -> Lwt.return (Script.force_decode script.code) >>=? fun script_code -> trace (Runtime_contract_error (self, script_code)) diff --git a/src/proto_alpha/lib_protocol/src/script_interpreter.mli b/src/proto_alpha/lib_protocol/src/script_interpreter.mli index 2324b2fcc..76c437ad3 100644 --- a/src/proto_alpha/lib_protocol/src/script_interpreter.mli +++ b/src/proto_alpha/lib_protocol/src/script_interpreter.mli @@ -12,6 +12,7 @@ open Alpha_context type error += Overflow of Script.location type error += Reject of Script.location type error += Runtime_contract_error : Contract.t * Script.expr -> error +type error += Bad_contract_parameter of Contract.t (* `Permanent *) type execution_result = { ctxt : context ;