better error message when a contract in invalid
This commit is contained in:
parent
c0472629b9
commit
df0dfb029b
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user