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

running contract or function does not fail on failwiths

Browse Source
This commit is contained in:
Lesenechal Remi 2020-01-17 16:30:36 +01:00
parent 0ad8bde6d1
commit 600ee51940
3 changed files with 82 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
src/bin/cli.ml
View File

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

78
src/main/run/of_michelson.ml
View File

@ -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
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 ()

4
src/test/test_helpers.ml
View File

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