compile_parameter and compile_storage CLI commands now gets their input checked

This commit is contained in:
Lesenechal Remi 2019-12-16 11:29:49 +01:00
parent a8fdbbfd84
commit ea343760b2
3 changed files with 20 additions and 10 deletions

View File

@ -150,11 +150,6 @@ let measure_contract =
let compile_parameter = let compile_parameter =
let f source_file entry_point expression syntax display_format michelson_format = let f source_file entry_point expression syntax display_format michelson_format =
toplevel ~display_format @@ toplevel ~display_format @@
(*
TODO:
source_to_michelson_contract will fail if the entry_point does not point to a michelson contract
but we do not check that the type of the parameter matches the type of the given expression
*)
let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in
let%bind typed_prg,state = Compile.Of_simplified.compile simplified in let%bind typed_prg,state = Compile.Of_simplified.compile simplified in
let%bind mini_c_prg = Compile.Of_typed.compile typed_prg in let%bind mini_c_prg = Compile.Of_typed.compile typed_prg in
@ -169,6 +164,7 @@ let compile_parameter =
let%bind (typed_param,_) = Compile.Of_simplified.compile_expression ~env ~state simplified_param in let%bind (typed_param,_) = Compile.Of_simplified.compile_expression ~env ~state simplified_param in
let%bind mini_c_param = Compile.Of_typed.compile_expression typed_param in let%bind mini_c_param = Compile.Of_typed.compile_expression typed_param in
let%bind compiled_param = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg mini_c_param in let%bind compiled_param = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg mini_c_param in
let%bind () = Compile.Of_mini_c.assert_equal_michelson_type Check_parameter michelson_prg compiled_param in
let%bind value = Run.evaluate_expression compiled_param.expr compiled_param.expr_ty in let%bind value = Run.evaluate_expression compiled_param.expr compiled_param.expr_ty in
ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value
in in
@ -210,11 +206,6 @@ let interpret =
let compile_storage = let compile_storage =
let f source_file entry_point expression syntax display_format michelson_format = let f source_file entry_point expression syntax display_format michelson_format =
toplevel ~display_format @@ toplevel ~display_format @@
(*
TODO:
source_to_michelson_contract will fail if the entry_point does not point to a michelson contract
but we do not check that the type of the storage matches the type of the given expression
*)
let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in
let%bind typed_prg,state = Compile.Of_simplified.compile simplified in let%bind typed_prg,state = Compile.Of_simplified.compile simplified in
let%bind mini_c_prg = Compile.Of_typed.compile typed_prg in let%bind mini_c_prg = Compile.Of_typed.compile typed_prg in
@ -229,6 +220,7 @@ let compile_storage =
let%bind (typed_param,_) = Compile.Of_simplified.compile_expression ~env ~state simplified_param in let%bind (typed_param,_) = Compile.Of_simplified.compile_expression ~env ~state simplified_param in
let%bind mini_c_param = Compile.Of_typed.compile_expression typed_param in let%bind mini_c_param = Compile.Of_typed.compile_expression typed_param in
let%bind compiled_param = Compile.Of_mini_c.compile_expression mini_c_param in let%bind compiled_param = Compile.Of_mini_c.compile_expression mini_c_param in
let%bind () = Compile.Of_mini_c.assert_equal_michelson_type Check_storage michelson_prg compiled_param in
let%bind value = Run.evaluate_expression compiled_param.expr compiled_param.expr_ty in let%bind value = Run.evaluate_expression compiled_param.expr compiled_param.expr_ty in
ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value
in in

View File

@ -47,3 +47,17 @@ let build_contract : Compiler.compiled_expression -> Michelson.michelson result
Trace.trace_tzresult_lwt (simple_error "Invalid contract: Contract did not typecheck") @@ 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
type check_type = Check_parameter | Check_storage
let assert_equal_michelson_type : check_type -> Compiler.compiled_expression -> Compiler.compiled_expression -> unit result =
fun c compiled_prg compiled_param ->
let%bind (Ex_ty expected_ty) =
let%bind (c_param_ty,c_storage_ty) = Self_michelson.fetch_contract_inputs compiled_prg.expr_ty in
match c with
| Check_parameter -> ok c_param_ty
| Check_storage -> ok c_storage_ty in
let (Ex_ty actual_ty) = compiled_param.expr_ty in
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 ()

View File

@ -1105,6 +1105,10 @@ let typecheck_contract contract =
Script_ir_translator.typecheck_code dummy_environment.tezos_context contract' >>=?? Script_ir_translator.typecheck_code dummy_environment.tezos_context contract' >>=??
fun _ -> return () fun _ -> return ()
let assert_equal_michelson_type ty1 ty2 =
(* alpha_wrap (Script_ir_translator.ty_eq tezos_context a b) >>? fun (Eq, _) -> *)
alpha_wrap (Script_ir_translator.ty_eq dummy_environment.tezos_context ty1 ty2)
type 'a interpret_res = type 'a interpret_res =
| Succeed of 'a stack | Succeed of 'a stack
| Fail of Script_repr.expr | Fail of Script_repr.expr