From 600ee519407a349f7ed4c45751799de9b6e4bf5c Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Fri, 17 Jan 2020 16:30:36 +0100 Subject: [PATCH] running contract or function does not fail on failwiths --- src/bin/cli.ml | 54 ++++++++++++++++--------- src/main/run/of_michelson.ml | 78 +++++++++++++++++++++--------------- src/test/test_helpers.ml | 4 +- 3 files changed, 82 insertions(+), 54 deletions(-) diff --git a/src/bin/cli.ml b/src/bin/cli.ml index a1275d78f..d8be0d864 100644 --- a/src/bin/cli.ml +++ b/src/bin/cli.ml @@ -196,15 +196,20 @@ let interpret = ok (mini_c_prg,state,env) | None -> ok ([],Typer.Solver.initial_state,Ast_typed.Environment.full_empty) in - let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) init_file in - let%bind simplified_exp = Compile.Of_source.compile_expression v_syntax expression in - let%bind (typed_exp,_) = Compile.Of_simplified.compile_expression ~env ~state simplified_exp in - let%bind mini_c_exp = Compile.Of_typed.compile_expression typed_exp in - let%bind compiled_exp = Compile.Of_mini_c.aggregate_and_compile_expression decl_list mini_c_exp in - let%bind options = Run.make_dry_run_options {predecessor_timestamp ; amount ; sender ; source } in - let%bind value = Run.run ~options compiled_exp.expr compiled_exp.expr_ty in - let%bind simplified_output = Uncompile.uncompile_expression typed_exp.type_annotation value in - ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output + let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) init_file in + let%bind simplified_exp = Compile.Of_source.compile_expression v_syntax expression in + let%bind (typed_exp,_) = Compile.Of_simplified.compile_expression ~env ~state simplified_exp in + let%bind mini_c_exp = Compile.Of_typed.compile_expression typed_exp in + let%bind compiled_exp = Compile.Of_mini_c.aggregate_and_compile_expression decl_list mini_c_exp in + let%bind options = Run.make_dry_run_options {predecessor_timestamp ; amount ; sender ; source } in + let%bind runres = Run.run_expression ~options compiled_exp.expr compiled_exp.expr_ty in + match runres with + | Fail fail_res -> + let%bind failstring = Run.failwith_to_string fail_res in + ok @@ Format.asprintf "%s" failstring + | Success value' -> + let%bind simplified_output = Uncompile.uncompile_expression typed_exp.type_annotation value' in + ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output in let term = Term.(const f $ expression "EXPRESSION" 0 $ init_file $ syntax $ amount $ sender $ source $ predecessor_timestamp $ display_format ) in @@ -262,10 +267,14 @@ let dry_run = let%bind args_michelson = Run.evaluate_expression compiled_params.expr compiled_params.expr_ty in let%bind options = Run.make_dry_run_options {predecessor_timestamp ; amount ; sender ; source } in - let%bind michelson_output = Run.run_contract ~options michelson_prg.expr michelson_prg.expr_ty args_michelson in - - let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_prg entry_point michelson_output in - ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output + let%bind runres = Run.run_contract ~options michelson_prg.expr michelson_prg.expr_ty args_michelson in + match runres with + | Fail fail_res -> + let%bind failstring = Run.failwith_to_string fail_res in + ok @@ Format.asprintf "%s" failstring + | Success michelson_output -> + let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_prg entry_point michelson_output in + ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output in let term = Term.(const f $ source_file 0 $ entry_point 1 $ expression "PARAMETER" 2 $ expression "STORAGE" 3 $ amount $ sender $ source $ predecessor_timestamp $ syntax $ display_format) in @@ -287,11 +296,16 @@ let run_function = let%bind (typed_app,_) = Compile.Of_simplified.compile_expression ~env ~state app in let%bind compiled_applied = Compile.Of_typed.compile_expression typed_app in - let%bind michelson = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg compiled_applied in - let%bind options = Run.make_dry_run_options {predecessor_timestamp ; amount ; sender ; source } in - let%bind michelson_output = Run.run ~options michelson.expr michelson.expr_ty in - let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_prg entry_point michelson_output in - ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output + let%bind michelson = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg compiled_applied in + let%bind options = Run.make_dry_run_options {predecessor_timestamp ; amount ; sender ; source } in + let%bind runres = Run.run_expression ~options michelson.expr michelson.expr_ty in + match runres with + | Fail fail_res -> + let%bind failstring = Run.failwith_to_string fail_res in + ok @@ Format.asprintf "%s" failstring + | Success michelson_output -> + let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_prg entry_point michelson_output in + ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output in let term = Term.(const f $ source_file 0 $ entry_point 1 $ expression "PARAMETER" 2 $ amount $ sender $ source $ predecessor_timestamp $ syntax $ display_format) in @@ -308,8 +322,8 @@ let evaluate_value = let%bind (exp,_) = Mini_c.get_entry mini_c entry_point in let%bind compiled = Compile.Of_mini_c.aggregate_and_compile_expression mini_c exp in let%bind options = Run.make_dry_run_options {predecessor_timestamp ; amount ; sender ; source } in - let%bind michelson_output = Run.run ~options compiled.expr compiled.expr_ty in - let%bind simplified_output = Uncompile.uncompile_typed_program_entry_expression_result typed_prg entry_point michelson_output in + let%bind michelson_output = Run.run_no_failwith ~options compiled.expr compiled.expr_ty in + let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_prg entry_point michelson_output in ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output in let term = diff --git a/src/main/run/of_michelson.ml b/src/main/run/of_michelson.ml index 03543a5c0..5a0d4682a 100644 --- a/src/main/run/of_michelson.ml +++ b/src/main/run/of_michelson.ml @@ -9,32 +9,41 @@ module Errors = struct let message () = "only bytes, string or int are printable" in error title message - let failwith data_str type_str () = + let failwith str () = let title () = "Execution failed" in let message () = "" in let data = [ - ("value" , fun () -> Format.asprintf "%s" data_str); - ("type" , fun () -> Format.asprintf "%s" type_str); + ("value" , fun () -> Format.asprintf "%s" str); ] in error ~data title message end -type options = Memory_proto_alpha.options -type run_res = - | Success of ex_typed_value - | Fail of Memory_proto_alpha.Protocol.Script_repr.expr +type options = Memory_proto_alpha.options type run_failwith_res = | Failwith_int of int | Failwith_string of string | Failwith_bytes of bytes +type run_res = + | Success of ex_typed_value + | Fail of run_failwith_res + type dry_run_options = { amount : string ; predecessor_timestamp : string option ; sender : string option ; source : string option } +let failwith_to_string (f:run_failwith_res) : string result = + let%bind str = match f with + | Failwith_int i -> ok @@ string_of_int i + | Failwith_string s -> ok @@ s + | Failwith_bytes b -> + generic_try (simple_error "Could not convert failwith bytes to string") @@ + (fun () -> Bytes.to_string b) in + ok @@ Format.asprintf "failed with value '%s'" str + let make_dry_run_options (opts : dry_run_options) : options result = let open Proto_alpha_utils.Trace in let open Proto_alpha_utils.Memory_proto_alpha in @@ -88,7 +97,7 @@ let fetch_lambda_types (contract_ty:ex_ty) = | Ex_ty (Lambda_t (in_ty, out_ty, _)) -> ok (Ex_ty in_ty, Ex_ty out_ty) | _ -> simple_fail "failed to fetch lambda types" -let run_contract ?options (exp:Michelson.t) (exp_type:ex_ty) (input_michelson:Michelson.t) : ex_typed_value result = +let run_contract ?options (exp:Michelson.t) (exp_type:ex_ty) (input_michelson:Michelson.t) : run_res result = let open! Tezos_raw_protocol_005_PsBabyM1 in let%bind (Ex_ty input_ty, Ex_ty output_ty) = fetch_lambda_types exp_type in let%bind input = @@ -105,11 +114,18 @@ let run_contract ?options (exp:Michelson.t) (exp_type:ex_ty) (input_michelson:Mi Trace.trace_tzresult_lwt (simple_error "error parsing program code") @@ Memory_proto_alpha.parse_michelson_fail ~top_level exp ty_stack_before ty_stack_after in let open! Memory_proto_alpha.Protocol.Script_interpreter in - let%bind (Item(output, Empty)) = + let%bind res = Trace.trace_tzresult_lwt (simple_error "error of execution") @@ - Memory_proto_alpha.interpret ?options descr - (Item(input, Empty)) in - ok (Ex_typed_value (output_ty, output)) + Memory_proto_alpha.failure_interpret ?options descr (Item(input, Empty)) in + match res with + | Memory_proto_alpha.Succeed stack -> + let (Item(output, Empty)) = stack in + ok @@ Success (Ex_typed_value (output_ty, output)) + | Memory_proto_alpha.Fail expr -> ( match Tezos_micheline.Micheline.root @@ Memory_proto_alpha.strings_of_prims expr with + | Int (_ , i) -> ok @@ Fail (Failwith_int (Z.to_int i)) + | String (_ , s) -> ok @@ Fail (Failwith_string s) + | Bytes (_, s) -> ok @@ Fail (Failwith_bytes s) + | _ -> fail @@ Errors.unknown_failwith_type () ) let run_expression ?options (exp:Michelson.t) (exp_type:ex_ty) : run_res result = let open! Tezos_raw_protocol_005_PsBabyM1 in @@ -129,30 +145,28 @@ let run_expression ?options (exp:Michelson.t) (exp_type:ex_ty) : run_res result | Memory_proto_alpha.Succeed stack -> let (Item(output, Empty)) = stack in ok @@ Success (Ex_typed_value (exp_type', output)) - | Memory_proto_alpha.Fail expr -> - ok (Fail expr) - -let run ?options (exp:Michelson.t) (exp_type:ex_ty) : ex_typed_value result = - let%bind expr = run_expression ?options exp exp_type in - match expr with - | Success res -> ok res - | Fail res -> ( match Tezos_micheline.Micheline.root @@ Memory_proto_alpha.strings_of_prims res with - | Int (_ , i) -> fail @@ Errors.failwith (Z.to_string i) "int" () - | String (_ , s) -> fail @@ Errors.failwith s "string" () - | Bytes (_, s) -> fail @@ Errors.failwith (Bytes.to_string s) "bytes" () + | Memory_proto_alpha.Fail expr -> ( match Tezos_micheline.Micheline.root @@ Memory_proto_alpha.strings_of_prims expr with + | Int (_ , i) -> ok @@ Fail (Failwith_int (Z.to_int i)) + | String (_ , s) -> ok @@ Fail (Failwith_string s) + | Bytes (_, s) -> ok @@ Fail (Failwith_bytes s) | _ -> fail @@ Errors.unknown_failwith_type () ) - let run_failwith ?options (exp:Michelson.t) (exp_type:ex_ty) : run_failwith_res result = let%bind expr = run_expression ?options exp exp_type in match expr with - | Fail res -> ( match Tezos_micheline.Micheline.root @@ Memory_proto_alpha.strings_of_prims res with - | Int (_ , i) -> ok (Failwith_int (Z.to_int i)) - | String (_ , s) -> ok (Failwith_string s) - | Bytes (_, b) -> ok (Failwith_bytes b) - | _ -> simple_fail "Unknown failwith type" ) - | _ -> simple_fail "An error of execution was expected" + | Success _ -> simple_fail "An error of execution was expected" + | Fail res -> ok res + +let run_no_failwith ?options (exp:Michelson.t) (exp_type:ex_ty) : ex_typed_value result = + let%bind expr = run_expression ?options exp exp_type in + match expr with + | Success tval -> ok tval + | Fail _ -> simple_fail "Unexpected error of execution" let evaluate_expression ?options exp exp_type = - let%bind etv = run ?options exp exp_type in - ex_value_ty_to_michelson etv \ No newline at end of file + let%bind etv = run_expression ?options exp exp_type in + match etv with + | Success etv' -> ex_value_ty_to_michelson etv' + | Fail res -> + let%bind str = failwith_to_string res in + fail @@ Errors.failwith str () \ No newline at end of file diff --git a/src/test/test_helpers.ml b/src/test/test_helpers.ml index 928e828e8..21f3fb1fc 100644 --- a/src/test/test_helpers.ml +++ b/src/test/test_helpers.ml @@ -93,7 +93,7 @@ let run_typed_program_with_simplified_input ?options (program: Ast_typed.program) (entry_point: string) (input: Ast_simplified.expression) : Ast_simplified.expression result = let%bind michelson_program = typed_program_with_simplified_input_to_michelson program entry_point input in - let%bind michelson_output = Ligo.Run.Of_michelson.run ?options michelson_program.expr michelson_program.expr_ty in + let%bind michelson_output = Ligo.Run.Of_michelson.run_no_failwith ?options michelson_program.expr michelson_program.expr_ty in Uncompile.uncompile_typed_program_entry_function_result program entry_point michelson_output let expect ?options program entry_point input expecter = @@ -147,7 +147,7 @@ let expect_evaluate program entry_point expecter = let%bind mini_c = Ligo.Compile.Of_typed.compile program in let%bind (exp,_) = Mini_c.get_entry mini_c entry_point in let%bind michelson_value = Ligo.Compile.Of_mini_c.aggregate_and_compile_expression mini_c exp in - let%bind res_michelson = Ligo.Run.Of_michelson.run michelson_value.expr michelson_value.expr_ty in + let%bind res_michelson = Ligo.Run.Of_michelson.run_no_failwith michelson_value.expr michelson_value.expr_ty in let%bind res_simpl = Uncompile.uncompile_typed_program_entry_expression_result program entry_point res_michelson in expecter res_simpl