From e834e2ac202a75d0eec2eca70a52d259bc5f535b Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Tue, 31 Dec 2019 19:14:42 +0100 Subject: [PATCH 1/3] More informative errors when calling michelson typecheck function --- src/main/compile/of_michelson.ml | 35 ++++++++++++++++--- .../proto-alpha-utils/x_memory_proto_alpha.ml | 16 +++++++-- 2 files changed, 43 insertions(+), 8 deletions(-) diff --git a/src/main/compile/of_michelson.ml b/src/main/compile/of_michelson.ml index 5e73d07c2..5b80fc993 100644 --- a/src/main/compile/of_michelson.ml +++ b/src/main/compile/of_michelson.ml @@ -2,20 +2,45 @@ open Tezos_utils open Proto_alpha_utils open Trace +module Errors = struct + let title_type_check_msg () = "Invalid contract" + let bad_parameter () = + let message () = + "bad contract parameter type (some michelson type are forbidden as contract parameter)" in + error title_type_check_msg message + let bad_storage () = + let message () = + "bad storage type (some michelson type are forbidden as contract storage)" in + error title_type_check_msg message + let bad_contract () = + let message () = + "bad contract type (contract entry point is expected to be of the form `parameter * storage -> list(operation) * storage`)" in + error title_type_check_msg message + let unknown () = + let message () = + "unknown error" in + error title_type_check_msg message +end + let build_contract : Compiler.compiled_expression -> Michelson.michelson result = fun compiled -> let%bind ((Ex_ty _param_ty),(Ex_ty _storage_ty)) = Self_michelson.fetch_contract_inputs compiled.expr_ty in let%bind param_michelson = - Trace.trace_tzresult_lwt (simple_error "Invalid contract: Could not unparse parameter") @@ + Trace.trace_tzresult_lwt (simple_error "Could not unparse parameter") @@ Proto_alpha_utils.Memory_proto_alpha.unparse_ty_michelson _param_ty in let%bind storage_michelson = - Trace.trace_tzresult_lwt (simple_error "Invalid contract: Could not unparse storage") @@ + Trace.trace_tzresult_lwt (simple_error "Could not unparse storage") @@ Proto_alpha_utils.Memory_proto_alpha.unparse_ty_michelson _storage_ty in let contract = Michelson.contract param_michelson storage_michelson compiled.expr in - let%bind () = - Trace.trace_tzresult_lwt (simple_error "Invalid contract: Contract did not typecheck") @@ + let%bind res = + Trace.trace_tzresult_lwt (simple_error "Could not typecheck the code") @@ Proto_alpha_utils.Memory_proto_alpha.typecheck_contract contract in - ok contract + match res with + | Type_checked -> ok contract + | Err_parameter -> fail @@ Errors.bad_parameter () + | Err_storage -> fail @@ Errors.bad_storage () + | Err_contract -> fail @@ Errors.bad_contract () + | Err_unknown -> fail @@ Errors.unknown () type check_type = Check_parameter | Check_storage let assert_equal_contract_type : check_type -> Compiler.compiled_expression -> Compiler.compiled_expression -> unit result = diff --git a/vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml b/vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml index d47b85086..c613c86a4 100644 --- a/vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml +++ b/vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml @@ -1103,10 +1103,20 @@ let unparse_ty_michelson ty = Script_ir_translator.unparse_ty dummy_environment.tezos_context ty >>=?? fun (n,_) -> return n +type typecheck_res = + | Type_checked + | Err_parameter | Err_storage | Err_contract + | Err_unknown + let typecheck_contract contract = let contract' = Tezos_micheline.Micheline.strip_locations contract in - Script_ir_translator.typecheck_code dummy_environment.tezos_context contract' >>=?? - fun _ -> return () + Script_ir_translator.typecheck_code dummy_environment.tezos_context contract' >>= fun x -> + match x with + | Ok _res -> return Type_checked + | Error (Script_tc_errors.Ill_formed_type (Some "parameter", _code, _)::_) -> return Err_parameter + | Error (Script_tc_errors.Ill_formed_type (Some "storage", _code, _)::_) -> return Err_storage + | Error (Script_tc_errors.Ill_typed_contract (_code, _)::_) -> return @@ Err_contract + | Error _ -> return Err_unknown let assert_equal_michelson_type ty1 ty2 = (* alpha_wrap (Script_ir_translator.ty_eq tezos_context a b) >>? fun (Eq, _) -> *) @@ -1117,7 +1127,7 @@ type 'a interpret_res = | Fail of Script_repr.expr let failure_interpret - ?(options = default_options) + ?(options = default_options) (instr:('a, 'b) descr) (bef:'a stack) : 'b interpret_res tzresult Lwt.t = let { From 5108b820cf7f7057836e1dd93b76113bc7578562 Mon Sep 17 00:00:00 2001 From: John David Pressman Date: Wed, 1 Jan 2020 14:15:49 -0800 Subject: [PATCH 2/3] Fix minor typos in wrong michelson contract parameter/storage msgs --- src/main/compile/of_michelson.ml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/main/compile/of_michelson.ml b/src/main/compile/of_michelson.ml index 5b80fc993..8aff10104 100644 --- a/src/main/compile/of_michelson.ml +++ b/src/main/compile/of_michelson.ml @@ -6,15 +6,15 @@ module Errors = struct let title_type_check_msg () = "Invalid contract" let bad_parameter () = let message () = - "bad contract parameter type (some michelson type are forbidden as contract parameter)" in + "bad contract parameter type (some michelson types are forbidden as contract parameter)" in error title_type_check_msg message let bad_storage () = let message () = - "bad storage type (some michelson type are forbidden as contract storage)" in + "bad storage type (some michelson types are forbidden as contract storage)" in error title_type_check_msg message let bad_contract () = let message () = - "bad contract type (contract entry point is expected to be of the form `parameter * storage -> list(operation) * storage`)" in + "bad contract type (contract entry point is expected to be of the form \"parameter * storage -> list(operation) * storage\")" in error title_type_check_msg message let unknown () = let message () = @@ -32,7 +32,7 @@ let build_contract : Compiler.compiled_expression -> Michelson.michelson result Trace.trace_tzresult_lwt (simple_error "Could not unparse storage") @@ Proto_alpha_utils.Memory_proto_alpha.unparse_ty_michelson _storage_ty in let contract = Michelson.contract param_michelson storage_michelson compiled.expr in - let%bind res = + let%bind res = Trace.trace_tzresult_lwt (simple_error "Could not typecheck the code") @@ Proto_alpha_utils.Memory_proto_alpha.typecheck_contract contract in match res with @@ -54,4 +54,4 @@ let assert_equal_contract_type : check_type -> Compiler.compiled_expression -> C let%bind _ = Trace.trace_tzresult (simple_error "Passed parameter does not match the contract type") @@ Proto_alpha_utils.Memory_proto_alpha.assert_equal_michelson_type expected_ty actual_ty in - ok () \ No newline at end of file + ok () From 72f4ed35f15aee65be82d87e4f9bcba931ce8d69 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Thu, 2 Jan 2020 12:31:10 +0100 Subject: [PATCH 3/3] print ill-typed michelson code --- src/main/compile/of_michelson.ml | 28 ++++++++++++++++++---------- 1 file changed, 18 insertions(+), 10 deletions(-) diff --git a/src/main/compile/of_michelson.ml b/src/main/compile/of_michelson.ml index 8aff10104..0b070fb79 100644 --- a/src/main/compile/of_michelson.ml +++ b/src/main/compile/of_michelson.ml @@ -3,18 +3,26 @@ open Proto_alpha_utils open Trace module Errors = struct - let title_type_check_msg () = "Invalid contract" - let bad_parameter () = +(* + TODO: those errors should have been caught in the earlier stages on the ligo pipeline + Here, in case of contract not typechecking, we should write a warning with a "please report" + on stderr and print the ill-typed michelson code; +*) + let title_type_check_msg () = "Invalid contract (This might be a compiler bug, please report) " + let bad_parameter c () = let message () = - "bad contract parameter type (some michelson types are forbidden as contract parameter)" in + let code = Format.asprintf "%a" Michelson.pp c in + "bad contract parameter type (some michelson types are forbidden as contract parameter):\n"^code in error title_type_check_msg message - let bad_storage () = + let bad_storage c () = let message () = - "bad storage type (some michelson types are forbidden as contract storage)" in + let code = Format.asprintf "%a" Michelson.pp c in + "bad storage type (some michelson types are forbidden as contract storage):\n"^code in error title_type_check_msg message - let bad_contract () = + let bad_contract c () = let message () = - "bad contract type (contract entry point is expected to be of the form \"parameter * storage -> list(operation) * storage\")" in + let code = Format.asprintf "%a" Michelson.pp c in + "bad contract type (contract entry point is expected to be of the form \"parameter * storage -> list(operation) * storage\"):\n"^code in error title_type_check_msg message let unknown () = let message () = @@ -37,9 +45,9 @@ let build_contract : Compiler.compiled_expression -> Michelson.michelson result Proto_alpha_utils.Memory_proto_alpha.typecheck_contract contract in match res with | Type_checked -> ok contract - | Err_parameter -> fail @@ Errors.bad_parameter () - | Err_storage -> fail @@ Errors.bad_storage () - | Err_contract -> fail @@ Errors.bad_contract () + | Err_parameter -> fail @@ Errors.bad_parameter contract () + | Err_storage -> fail @@ Errors.bad_storage contract () + | Err_contract -> fail @@ Errors.bad_contract contract () | Err_unknown -> fail @@ Errors.unknown () type check_type = Check_parameter | Check_storage