balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

More informative errors when calling michelson typecheck function

Browse Source
This commit is contained in:
Lesenechal Remi 2019-12-31 19:14:42 +01:00
parent 5f1182468c
commit e834e2ac20
2 changed files with 43 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
src/main/compile/of_michelson.ml
View File

@ -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 =

16
vendors/ligo-utils/proto-alpha-utils/x_memory_proto_alpha.ml vendored
View File

@ -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 {