better error message when a contract in invalid

This commit is contained in:
Lesenechal Remi 2019-12-11 19:25:17 +01:00
parent c0472629b9
commit df0dfb029b
2 changed files with 6 additions and 7 deletions

View File

@ -35,15 +35,15 @@ let aggregate_and_compile_expression = fun program exp ->
let build_contract : Compiler.compiled_expression -> Michelson.michelson result = let build_contract : Compiler.compiled_expression -> Michelson.michelson result =
fun compiled -> fun compiled ->
let%bind ((Ex_ty _param_ty),(Ex_ty _storage_ty)) = Self_michelson.fetch_lambda_parameters compiled.expr_ty in let%bind ((Ex_ty _param_ty),(Ex_ty _storage_ty)) = Self_michelson.fetch_contract_inputs compiled.expr_ty in
let%bind param_michelson = let%bind param_michelson =
Trace.trace_tzresult_lwt (simple_error "Could not unparse contract lambda's parameter") @@ Trace.trace_tzresult_lwt (simple_error "Invalid contract: Could not unparse parameter") @@
Proto_alpha_utils.Memory_proto_alpha.unparse_ty_michelson _param_ty in Proto_alpha_utils.Memory_proto_alpha.unparse_ty_michelson _param_ty in
let%bind storage_michelson = let%bind storage_michelson =
Trace.trace_tzresult_lwt (simple_error "Could not unparse contract lambda's storage") @@ Trace.trace_tzresult_lwt (simple_error "Invalid contract: Could not unparse storage") @@
Proto_alpha_utils.Memory_proto_alpha.unparse_ty_michelson _storage_ty in Proto_alpha_utils.Memory_proto_alpha.unparse_ty_michelson _storage_ty in
let contract = Michelson.contract param_michelson storage_michelson compiled.expr in let contract = Michelson.contract param_michelson storage_michelson compiled.expr in
let%bind () = let%bind () =
Trace.trace_tzresult_lwt (simple_error "Invalid contract") @@ Trace.trace_tzresult_lwt (simple_error "Invalid contract: Contract did not typecheck") @@
Proto_alpha_utils.Memory_proto_alpha.typecheck_contract contract in Proto_alpha_utils.Memory_proto_alpha.typecheck_contract contract in
ok contract ok contract

View File

@ -19,9 +19,8 @@ let rec map_expression : mapper -> michelson -> michelson result = fun f e ->
| x -> ok x | x -> ok x
open Memory_proto_alpha.Protocol.Script_ir_translator open Memory_proto_alpha.Protocol.Script_ir_translator
(* fetches lambda first and second parameter (parameter,storage) *) let fetch_contract_inputs : ex_ty -> (ex_ty * ex_ty) result =
let fetch_lambda_parameters : ex_ty -> (ex_ty * ex_ty) result = let error () = simple_fail "Invalid contract: Failed to fetch parameter and storage" in
let error () = simple_fail "failed to fetch lambda parameters" in
function function
| Ex_ty (Lambda_t (in_ty, _, _)) -> ( | Ex_ty (Lambda_t (in_ty, _, _)) -> (
match in_ty with match in_ty with