From e8e66a83c77995a6c2c7fcb5ac2409beb68eb5f1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Mon, 4 Jun 2018 14:35:06 +0200 Subject: [PATCH] Tests/helpers: replace old test framework --- .../lib_protocol/test/contracts/accounts.tz | 43 -- .../lib_protocol/test/contracts/add1.tz | 7 - .../lib_protocol/test/contracts/add1_list.tz | 6 - .../test/contracts/add_delta_timestamp.tz | 3 - .../test/contracts/add_timestamp_delta.tz | 3 - .../test/contracts/after_strategy.tz | 3 - .../lib_protocol/test/contracts/always.tz | 4 - .../lib_protocol/test/contracts/and.tz | 3 - .../lib_protocol/test/contracts/append.tz | 13 - .../lib_protocol/test/contracts/assert.tz | 3 - .../test/contracts/assert_cmpeq.tz | 3 - .../test/contracts/assert_cmpge.tz | 3 - .../test/contracts/assert_cmpgt.tz | 3 - .../test/contracts/assert_cmple.tz | 3 - .../test/contracts/assert_cmplt.tz | 3 - .../test/contracts/assert_cmpneq.tz | 3 - .../lib_protocol/test/contracts/assert_eq.tz | 3 - .../lib_protocol/test/contracts/assert_ge.tz | 3 - .../lib_protocol/test/contracts/assert_gt.tz | 3 - .../lib_protocol/test/contracts/assert_le.tz | 3 - .../lib_protocol/test/contracts/assert_lt.tz | 3 - .../lib_protocol/test/contracts/assert_neq.tz | 3 - .../lib_protocol/test/contracts/at_least.tz | 6 - .../lib_protocol/test/contracts/auction.tz | 8 - .../lib_protocol/test/contracts/bad_lockup.tz | 6 - .../lib_protocol/test/contracts/balance.tz | 3 - .../lib_protocol/test/contracts/build_list.tz | 6 - .../test/contracts/cadr_annotation.tz | 3 - .../test/contracts/check_signature.tz | 8 - .../lib_protocol/test/contracts/compare.tz | 9 - .../lib_protocol/test/contracts/concat.tz | 8 - .../test/contracts/concat_hello.tz | 4 - .../test/contracts/concat_list.tz | 5 - .../test/contracts/conditionals.tz | 9 - .../lib_protocol/test/contracts/cons_twice.tz | 9 - .../test/contracts/contains_all.tz | 7 - .../test/contracts/create_account.tz | 12 - .../test/contracts/create_add1_lists.tz | 17 - .../test/contracts/create_contract.tz | 18 - .../test/contracts/data_publisher.tz | 8 - .../test/contracts/default_account.tz | 5 - .../test/contracts/diff_timestamps.tz | 3 - .../lib_protocol/test/contracts/dispatch.tz | 9 - .../lib_protocol/test/contracts/empty.tz | 3 - .../lib_protocol/test/contracts/empty_map.tz | 6 - .../test/contracts/exec_concat.tz | 5 - .../lib_protocol/test/contracts/fail.tz | 5 - .../test/contracts/fail_amount.tz | 6 - .../lib_protocol/test/contracts/first.tz | 3 - .../test/contracts/get_map_value.tz | 3 - .../lib_protocol/test/contracts/hardlimit.tz | 5 - .../contracts/hash_consistency_checker.tz | 3 - .../lib_protocol/test/contracts/hash_key.tz | 3 - .../test/contracts/hash_string.tz | 3 - .../lib_protocol/test/contracts/id.tz | 3 - .../lib_protocol/test/contracts/if.tz | 3 - .../lib_protocol/test/contracts/if_some.tz | 3 - .../test/contracts/infinite_loop.tz | 3 - .../test/contracts/insertion_sort.tz | 25 - .../test/contracts/int_publisher.tz | 17 - .../test/contracts/king_of_tez.tz | 19 - .../lib_protocol/test/contracts/list_id.tz | 3 - .../test/contracts/list_id_map.tz | 3 - .../lib_protocol/test/contracts/list_iter.tz | 5 - .../lib_protocol/test/contracts/list_iter2.tz | 5 - .../test/contracts/list_map_block.tz | 5 - .../test/contracts/list_of_transactions.tz | 8 - .../lib_protocol/test/contracts/lockup.tz | 18 - .../lib_protocol/test/contracts/loop_left.tz | 7 - .../test/contracts/macro_annotations.tz | 6 - .../test/contracts/map_caddaadr.tz | 4 - .../lib_protocol/test/contracts/map_car.tz | 3 - .../lib_protocol/test/contracts/map_id.tz | 3 - .../lib_protocol/test/contracts/map_iter.tz | 6 - .../lib_protocol/test/contracts/map_size.tz | 3 - .../test/contracts/max_in_list.tz | 9 - .../lib_protocol/test/contracts/min.tz | 11 - .../lib_protocol/test/contracts/noop.tz | 3 - .../lib_protocol/test/contracts/not.tz | 3 - .../lib_protocol/test/contracts/or.tz | 3 - .../lib_protocol/test/contracts/originator.tz | 16 - .../lib_protocol/test/contracts/pair_id.tz | 3 - .../lib_protocol/test/contracts/pair_macro.tz | 4 - .../test/contracts/parameterized_multisig.tz | 24 - .../lib_protocol/test/contracts/queue.tz | 24 - .../lib_protocol/test/contracts/reduce_map.tz | 21 - .../lib_protocol/test/contracts/reentrancy.tz | 7 - .../lib_protocol/test/contracts/ret_int.tz | 3 - .../lib_protocol/test/contracts/reverse.tz | 5 - .../test/contracts/reverse_loop.tz | 5 - .../lib_protocol/test/contracts/self.tz | 3 - .../test/contracts/set_caddaadr.tz | 5 - .../lib_protocol/test/contracts/set_car.tz | 3 - .../lib_protocol/test/contracts/set_cdr.tz | 3 - .../lib_protocol/test/contracts/set_id.tz | 3 - .../lib_protocol/test/contracts/set_iter.tz | 3 - .../lib_protocol/test/contracts/set_member.tz | 3 - .../lib_protocol/test/contracts/set_size.tz | 3 - .../test/contracts/spawn_identities.tz | 22 - .../test/contracts/steps_to_quota.tz | 3 - .../test/contracts/store_input.tz | 3 - .../lib_protocol/test/contracts/store_now.tz | 3 - .../lib_protocol/test/contracts/str_id.tz | 3 - .../test/contracts/sub_timestamp_delta.tz | 3 - .../lib_protocol/test/contracts/subset.tz | 17 - .../test/contracts/swap_left_right.tz | 3 - .../test/contracts/take_my_money.tz | 9 - .../test/contracts/tez_add_sub.tz | 5 - .../test/contracts/transfer_amount.tz | 3 - .../test/contracts/transfer_to.tz | 5 - .../test/contracts/unpair_macro.tz | 3 - .../test/contracts/weather_insurance.tz | 18 - .../lib_protocol/test/contracts/xor.tz | 3 - .../lib_protocol/test/helpers/account.ml | 58 ++ .../lib_protocol/test/helpers/account.mli | 31 ++ .../lib_protocol/test/helpers/assert.ml | 97 ++++ .../lib_protocol/test/helpers/block.ml | 380 +++++++++++++ .../lib_protocol/test/helpers/block.mli | 115 ++++ .../lib_protocol/test/helpers/context.ml | 148 +++++ .../lib_protocol/test/helpers/context.mli | 53 ++ .../test/helpers/helpers_account.ml | 105 ---- .../test/helpers/helpers_account.mli | 64 --- .../test/helpers/helpers_apply.ml | 116 ---- .../test/helpers/helpers_apply.mli | 58 -- .../test/helpers/helpers_assert.ml | 222 -------- .../test/helpers/helpers_assert.mli | 89 --- .../test/helpers/helpers_block.ml | 195 ------- .../test/helpers/helpers_block.mli | 81 --- .../lib_protocol/test/helpers/helpers_cast.ml | 40 -- .../test/helpers/helpers_cast.mli | 27 - .../test/helpers/helpers_crypto.ml | 19 - .../test/helpers/helpers_crypto.mli | 13 - .../lib_protocol/test/helpers/helpers_init.ml | 91 ---- .../test/helpers/helpers_logger.ml | 11 - .../test/helpers/helpers_logger.mli | 12 - .../lib_protocol/test/helpers/helpers_misc.ml | 35 -- .../test/helpers/helpers_operation.ml | 146 ----- .../test/helpers/helpers_operation.mli | 71 --- .../test/helpers/helpers_script.ml | 43 -- .../lib_protocol/test/helpers/incremental.ml | 114 ++++ .../{helpers_services.ml => incremental.mli} | 25 +- .../test/helpers/isolate_helpers.ml | 53 -- .../lib_protocol/test/helpers/jbuild | 5 +- .../lib_protocol/test/helpers/nonce.ml | 33 ++ .../helpers/{helpers_init.mli => nonce.mli} | 7 +- .../lib_protocol/test/helpers/op.ml | 178 ++++++ .../lib_protocol/test/helpers/op.mli | 72 +++ .../lib_protocol/test/helpers/proto_alpha.ml | 10 +- .../helpers/{helpers_misc.mli => test.ml} | 20 +- .../{helpers_script.mli => test_tez.ml} | 20 +- .../{helpers_services.mli => test_utils.ml} | 25 +- src/proto_alpha/lib_protocol/test/jbuild | 25 +- src/proto_alpha/lib_protocol/test/main.ml | 28 +- .../lib_protocol/test/michelson_parser/jbuild | 10 +- .../{michelson_v1_parser.ml => v1.ml} | 0 .../{michelson_v1_parser.mli => v1.mli} | 0 .../lib_protocol/test/sandbox.json | 0 .../lib_protocol/test/test_activation.ml | 82 --- .../lib_protocol/test/test_big_maps.ml | 125 ----- src/proto_alpha/lib_protocol/test/test_dsl.ml | 156 ------ .../lib_protocol/test/test_endorsement.ml | 146 ----- .../lib_protocol/test/test_michelson.ml | 508 ------------------ .../lib_protocol/test/test_origination.ml | 78 --- .../lib_protocol/test/test_transaction.ml | 153 ------ 164 files changed, 1380 insertions(+), 3567 deletions(-) delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/accounts.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/add1.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/add1_list.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/add_delta_timestamp.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/add_timestamp_delta.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/after_strategy.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/always.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/and.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/append.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/assert.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/assert_cmpeq.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/assert_cmpge.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/assert_cmpgt.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/assert_cmple.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/assert_cmplt.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/assert_cmpneq.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/assert_eq.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/assert_ge.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/assert_gt.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/assert_le.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/assert_lt.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/assert_neq.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/at_least.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/auction.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/bad_lockup.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/balance.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/build_list.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/cadr_annotation.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/check_signature.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/compare.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/concat.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/concat_hello.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/concat_list.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/conditionals.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/cons_twice.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/contains_all.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/create_account.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/create_add1_lists.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/create_contract.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/data_publisher.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/default_account.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/diff_timestamps.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/dispatch.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/empty.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/empty_map.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/exec_concat.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/fail.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/fail_amount.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/first.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/get_map_value.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/hardlimit.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/hash_consistency_checker.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/hash_key.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/hash_string.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/id.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/if.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/if_some.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/infinite_loop.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/insertion_sort.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/int_publisher.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/king_of_tez.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/list_id.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/list_id_map.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/list_iter.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/list_iter2.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/list_map_block.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/list_of_transactions.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/lockup.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/loop_left.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/macro_annotations.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/map_caddaadr.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/map_car.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/map_id.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/map_iter.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/map_size.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/max_in_list.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/min.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/noop.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/not.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/or.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/originator.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/pair_id.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/pair_macro.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/parameterized_multisig.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/queue.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/reduce_map.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/reentrancy.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/ret_int.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/reverse.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/reverse_loop.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/self.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/set_caddaadr.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/set_car.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/set_cdr.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/set_id.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/set_iter.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/set_member.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/set_size.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/spawn_identities.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/steps_to_quota.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/store_input.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/store_now.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/str_id.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/sub_timestamp_delta.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/subset.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/swap_left_right.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/take_my_money.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/tez_add_sub.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/transfer_amount.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/transfer_to.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/unpair_macro.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/weather_insurance.tz delete mode 100644 src/proto_alpha/lib_protocol/test/contracts/xor.tz create mode 100644 src/proto_alpha/lib_protocol/test/helpers/account.ml create mode 100644 src/proto_alpha/lib_protocol/test/helpers/account.mli create mode 100644 src/proto_alpha/lib_protocol/test/helpers/assert.ml create mode 100644 src/proto_alpha/lib_protocol/test/helpers/block.ml create mode 100644 src/proto_alpha/lib_protocol/test/helpers/block.mli create mode 100644 src/proto_alpha/lib_protocol/test/helpers/context.ml create mode 100644 src/proto_alpha/lib_protocol/test/helpers/context.mli delete mode 100644 src/proto_alpha/lib_protocol/test/helpers/helpers_account.ml delete mode 100644 src/proto_alpha/lib_protocol/test/helpers/helpers_account.mli delete mode 100644 src/proto_alpha/lib_protocol/test/helpers/helpers_apply.ml delete mode 100644 src/proto_alpha/lib_protocol/test/helpers/helpers_apply.mli delete mode 100644 src/proto_alpha/lib_protocol/test/helpers/helpers_assert.ml delete mode 100644 src/proto_alpha/lib_protocol/test/helpers/helpers_assert.mli delete mode 100644 src/proto_alpha/lib_protocol/test/helpers/helpers_block.ml delete mode 100644 src/proto_alpha/lib_protocol/test/helpers/helpers_block.mli delete mode 100644 src/proto_alpha/lib_protocol/test/helpers/helpers_cast.ml delete mode 100644 src/proto_alpha/lib_protocol/test/helpers/helpers_cast.mli delete mode 100644 src/proto_alpha/lib_protocol/test/helpers/helpers_crypto.ml delete mode 100644 src/proto_alpha/lib_protocol/test/helpers/helpers_crypto.mli delete mode 100644 src/proto_alpha/lib_protocol/test/helpers/helpers_init.ml delete mode 100644 src/proto_alpha/lib_protocol/test/helpers/helpers_logger.ml delete mode 100644 src/proto_alpha/lib_protocol/test/helpers/helpers_logger.mli delete mode 100644 src/proto_alpha/lib_protocol/test/helpers/helpers_misc.ml delete mode 100644 src/proto_alpha/lib_protocol/test/helpers/helpers_operation.ml delete mode 100644 src/proto_alpha/lib_protocol/test/helpers/helpers_operation.mli delete mode 100644 src/proto_alpha/lib_protocol/test/helpers/helpers_script.ml create mode 100644 src/proto_alpha/lib_protocol/test/helpers/incremental.ml rename src/proto_alpha/lib_protocol/test/helpers/{helpers_services.ml => incremental.mli} (55%) delete mode 100644 src/proto_alpha/lib_protocol/test/helpers/isolate_helpers.ml create mode 100644 src/proto_alpha/lib_protocol/test/helpers/nonce.ml rename src/proto_alpha/lib_protocol/test/helpers/{helpers_init.mli => nonce.mli} (75%) create mode 100644 src/proto_alpha/lib_protocol/test/helpers/op.ml create mode 100644 src/proto_alpha/lib_protocol/test/helpers/op.mli rename src/proto_alpha/lib_protocol/test/helpers/{helpers_misc.mli => test.ml} (61%) rename src/proto_alpha/lib_protocol/test/helpers/{helpers_script.mli => test_tez.ml} (53%) rename src/proto_alpha/lib_protocol/test/helpers/{helpers_services.mli => test_utils.ml} (52%) rename src/proto_alpha/lib_protocol/test/michelson_parser/{michelson_v1_parser.ml => v1.ml} (100%) rename src/proto_alpha/lib_protocol/test/michelson_parser/{michelson_v1_parser.mli => v1.mli} (100%) delete mode 100644 src/proto_alpha/lib_protocol/test/sandbox.json delete mode 100644 src/proto_alpha/lib_protocol/test/test_activation.ml delete mode 100644 src/proto_alpha/lib_protocol/test/test_big_maps.ml delete mode 100644 src/proto_alpha/lib_protocol/test/test_dsl.ml delete mode 100644 src/proto_alpha/lib_protocol/test/test_endorsement.ml delete mode 100644 src/proto_alpha/lib_protocol/test/test_michelson.ml delete mode 100644 src/proto_alpha/lib_protocol/test/test_origination.ml delete mode 100644 src/proto_alpha/lib_protocol/test/test_transaction.ml diff --git a/src/proto_alpha/lib_protocol/test/contracts/accounts.tz b/src/proto_alpha/lib_protocol/test/contracts/accounts.tz deleted file mode 100644 index 2496225d9..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/accounts.tz +++ /dev/null @@ -1,43 +0,0 @@ -# This is a very simple accounts system. -# (Left key) initializes or deposits into an account -# (Right key (pair mutez (signed mutez))) withdraws mutez amount to a -# IMPLICIT_ACCOUNT created from the key if the balance is available -# and the key is correctly signed -parameter (or key_hash (pair key (pair mutez signature))); -# Maps the key to the balance they have stored -storage (map key_hash mutez); -code { DUP; CAR; - # Deposit into account - IF_LEFT { DUP; DIIP{ CDR; DUP }; - DIP{ SWAP }; GET; - # Create the account - IF_NONE { DIP{ AMOUNT; SOME }; UPDATE; NIL operation; PAIR } - # Add to an existing account - { AMOUNT; ADD; SOME; SWAP; UPDATE; NIL operation; PAIR }} - # Withdrawl - { DUP; DUP; DUP; DUP; - # Check signature on data - CAR; DIIP{ CDAR; H }; DIP{ CDDR }; CHECK_SIGNATURE; - IF {} { FAIL }; - # Get user account information - DIIP{ CDR; DUP }; CAR; HASH_KEY; DIP{ SWAP }; GET; - # Account does not exist - IF_NONE { FAIL } - # Account exists - { DUP; DIIP{ DUP; CDAR; DUP }; - # Ensure funds are available - DIP{ CMPLT }; SWAP; - IF { FAIL } - { SUB; DIP{ DUP; DIP{ SWAP }}; DUP; - # Delete account if balance is 0 - PUSH mutez 0; CMPEQ; - IF { DROP; NONE mutez } - # Otherwise update storage with new balance - { SOME }; - SWAP; CAR; HASH_KEY; UPDATE; - SWAP; DUP; CDAR; - # Execute the transfer - DIP{ CAR; HASH_KEY; IMPLICIT_ACCOUNT }; UNIT; - TRANSFER_TOKENS; - NIL operation; SWAP; CONS; - PAIR }}}} diff --git a/src/proto_alpha/lib_protocol/test/contracts/add1.tz b/src/proto_alpha/lib_protocol/test/contracts/add1.tz deleted file mode 100644 index 78d4f9d1c..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/add1.tz +++ /dev/null @@ -1,7 +0,0 @@ -parameter int; -storage int; -code {CAR; # Get the parameter - PUSH int 1; # We're adding 1, so we need to put 1 on the stack - ADD; # Add the two numbers - NIL operation; # We put an empty list of operations on the stack - PAIR} # Create the end value diff --git a/src/proto_alpha/lib_protocol/test/contracts/add1_list.tz b/src/proto_alpha/lib_protocol/test/contracts/add1_list.tz deleted file mode 100644 index 084868c5e..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/add1_list.tz +++ /dev/null @@ -1,6 +0,0 @@ -parameter (list int); -storage (list int); -code { CAR; # Get the parameter - MAP { PUSH int 1; ADD }; # Map over the list adding one - NIL operation; # No internal op - PAIR } # Match the calling convetion diff --git a/src/proto_alpha/lib_protocol/test/contracts/add_delta_timestamp.tz b/src/proto_alpha/lib_protocol/test/contracts/add_delta_timestamp.tz deleted file mode 100644 index b9ed86901..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/add_delta_timestamp.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (pair int timestamp); -storage (option timestamp); -code { CAR; DUP; CAR; DIP{CDR}; ADD; SOME; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/add_timestamp_delta.tz b/src/proto_alpha/lib_protocol/test/contracts/add_timestamp_delta.tz deleted file mode 100644 index 766bf9f91..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/add_timestamp_delta.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (pair timestamp int); -storage (option timestamp); -code { CAR; DUP; CAR; DIP{CDR}; ADD; SOME; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/after_strategy.tz b/src/proto_alpha/lib_protocol/test/contracts/after_strategy.tz deleted file mode 100644 index 70812e52b..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/after_strategy.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter nat; -storage (pair (pair nat bool) timestamp); -code {DUP; CAR; DIP{CDDR; DUP; NOW; CMPGT}; PAIR; PAIR ; NIL operation ; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/always.tz b/src/proto_alpha/lib_protocol/test/contracts/always.tz deleted file mode 100644 index a7802fec9..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/always.tz +++ /dev/null @@ -1,4 +0,0 @@ -parameter nat; -storage (pair nat bool); -code { CAR; PUSH bool True; SWAP; - PAIR; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/and.tz b/src/proto_alpha/lib_protocol/test/contracts/and.tz deleted file mode 100644 index d723e72eb..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/and.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (pair (bool @first) (bool @second)); -storage (option bool); -code { CAR @param; DUP; CAR @first; DIP{CDR @second}; AND; SOME; NIL operation; PAIR }; diff --git a/src/proto_alpha/lib_protocol/test/contracts/append.tz b/src/proto_alpha/lib_protocol/test/contracts/append.tz deleted file mode 100644 index 46a9d8217..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/append.tz +++ /dev/null @@ -1,13 +0,0 @@ -parameter (pair (list int) (list int)); -storage (list int); -code { CAR; DUP; DIP{CDR}; CAR; # Unpack lists - NIL int; SWAP; # Setup reverse accumulator - LAMBDA (pair int (list int)) - (list int) - {DUP; CAR; DIP{CDR}; CONS}; - REDUCE; # Reverse list - LAMBDA (pair int (list int)) - (list int) - {DUP; CAR; DIP{CDR}; CONS}; - REDUCE; # Append reversed list - NIL operation; PAIR} # Calling convention diff --git a/src/proto_alpha/lib_protocol/test/contracts/assert.tz b/src/proto_alpha/lib_protocol/test/contracts/assert.tz deleted file mode 100644 index 6c5ce503b..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/assert.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter bool; -storage unit; -code {CAR; ASSERT; UNIT; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/assert_cmpeq.tz b/src/proto_alpha/lib_protocol/test/contracts/assert_cmpeq.tz deleted file mode 100644 index 55621bac8..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/assert_cmpeq.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (pair int int); -storage unit; -code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPEQ; UNIT; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/assert_cmpge.tz b/src/proto_alpha/lib_protocol/test/contracts/assert_cmpge.tz deleted file mode 100644 index e98b17044..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/assert_cmpge.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (pair int int); -storage unit; -code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPGE; UNIT; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/assert_cmpgt.tz b/src/proto_alpha/lib_protocol/test/contracts/assert_cmpgt.tz deleted file mode 100644 index 7a44174b7..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/assert_cmpgt.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (pair int int); -storage unit; -code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPGT; UNIT; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/assert_cmple.tz b/src/proto_alpha/lib_protocol/test/contracts/assert_cmple.tz deleted file mode 100644 index e4b61cfc4..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/assert_cmple.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (pair int int); -storage unit; -code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPLE; UNIT; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/assert_cmplt.tz b/src/proto_alpha/lib_protocol/test/contracts/assert_cmplt.tz deleted file mode 100644 index 290b49537..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/assert_cmplt.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (pair int int); -storage unit; -code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPLT; UNIT; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/assert_cmpneq.tz b/src/proto_alpha/lib_protocol/test/contracts/assert_cmpneq.tz deleted file mode 100644 index 86b601393..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/assert_cmpneq.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (pair int int); -storage unit; -code {CAR; DUP; CAR; DIP{CDR}; ASSERT_CMPNEQ; UNIT; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/assert_eq.tz b/src/proto_alpha/lib_protocol/test/contracts/assert_eq.tz deleted file mode 100644 index 338096a62..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/assert_eq.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (pair int int); -storage unit; -code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_EQ; UNIT; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/assert_ge.tz b/src/proto_alpha/lib_protocol/test/contracts/assert_ge.tz deleted file mode 100644 index 06bb3cec9..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/assert_ge.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (pair int int); -storage unit; -code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_GE; UNIT; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/assert_gt.tz b/src/proto_alpha/lib_protocol/test/contracts/assert_gt.tz deleted file mode 100644 index d041093b0..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/assert_gt.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (pair int int); -storage unit; -code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_GT; UNIT; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/assert_le.tz b/src/proto_alpha/lib_protocol/test/contracts/assert_le.tz deleted file mode 100644 index 8250f3f3b..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/assert_le.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (pair int int); -storage unit; -code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_LE; UNIT; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/assert_lt.tz b/src/proto_alpha/lib_protocol/test/contracts/assert_lt.tz deleted file mode 100644 index e387e9d74..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/assert_lt.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (pair int int); -storage unit; -code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_LT; UNIT; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/assert_neq.tz b/src/proto_alpha/lib_protocol/test/contracts/assert_neq.tz deleted file mode 100644 index 83f19559e..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/assert_neq.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (pair int int); -storage unit; -code {CAR; DUP; CAR; DIP{CDR}; COMPARE; ASSERT_NEQ; UNIT; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/at_least.tz b/src/proto_alpha/lib_protocol/test/contracts/at_least.tz deleted file mode 100644 index 6c6d2968c..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/at_least.tz +++ /dev/null @@ -1,6 +0,0 @@ -parameter unit; -storage mutez; # How much you have to send me -code {CDR; DUP; # Get the amount required (once for comparison, once to save back in storage) - AMOUNT; CMPLT; # Check to make sure no one is wasting my time - IF {FAIL} # Reject the person - {NIL operation;PAIR}} # Finish the transaction diff --git a/src/proto_alpha/lib_protocol/test/contracts/auction.tz b/src/proto_alpha/lib_protocol/test/contracts/auction.tz deleted file mode 100644 index af8aedfb7..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/auction.tz +++ /dev/null @@ -1,8 +0,0 @@ -parameter key_hash; -storage (pair timestamp (pair mutez key_hash)); -code { DUP; CDAR; DUP; NOW; CMPGT; IF {FAIL} {}; SWAP; # Check if auction has ended - DUP; CAR; DIP{CDDR}; AMOUNT; PAIR; SWAP; DIP{SWAP; PAIR}; # Setup replacement storage - DUP; CAR; AMOUNT; CMPLE; IF {FAIL} {}; # Check to make sure that the new amount is greater - DUP; CAR; # Get amount of refund - DIP{CDR; IMPLICIT_ACCOUNT}; UNIT; TRANSFER_TOKENS; # Make refund - NIL operation; SWAP; CONS; PAIR} # Calling convention diff --git a/src/proto_alpha/lib_protocol/test/contracts/bad_lockup.tz b/src/proto_alpha/lib_protocol/test/contracts/bad_lockup.tz deleted file mode 100644 index aeb3ec7fe..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/bad_lockup.tz +++ /dev/null @@ -1,6 +0,0 @@ -parameter unit; -storage (pair timestamp (pair (contract unit) (contract unit))); -code { CDR; DUP; CAR; NOW; CMPLT; IF {FAIL} {}; - DUP; CDAR; PUSH mutez 100000000; UNIT; TRANSFER_TOKENS; SWAP; - DUP; CDDR; PUSH mutez 100000000; UNIT; TRANSFER_TOKENS; DIP {SWAP} ; - NIL operation ; SWAP ; CONS ; SWAP ; CONS ; PAIR } diff --git a/src/proto_alpha/lib_protocol/test/contracts/balance.tz b/src/proto_alpha/lib_protocol/test/contracts/balance.tz deleted file mode 100644 index 0a9bfc614..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/balance.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter unit; -storage mutez; -code {DROP; BALANCE; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/build_list.tz b/src/proto_alpha/lib_protocol/test/contracts/build_list.tz deleted file mode 100644 index 842056d91..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/build_list.tz +++ /dev/null @@ -1,6 +0,0 @@ -parameter nat; -storage (list nat); -code { CAR @counter; NIL @acc nat; SWAP; DUP @cmp_num; PUSH nat 0; CMPNEQ; - LOOP { DUP; DIP {SWAP}; CONS @acc; SWAP; PUSH nat 1; SWAP; SUB @counter; - DUP; DIP{ABS}; PUSH int 0; CMPNEQ}; - CONS; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/cadr_annotation.tz b/src/proto_alpha/lib_protocol/test/contracts/cadr_annotation.tz deleted file mode 100644 index b83d483e5..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/cadr_annotation.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (pair (pair unit (string @no_name)) bool); -storage unit; -code { CAR @name; CADR @second_name; DROP; UNIT; NIL operation; PAIR } diff --git a/src/proto_alpha/lib_protocol/test/contracts/check_signature.tz b/src/proto_alpha/lib_protocol/test/contracts/check_signature.tz deleted file mode 100644 index 65d319d58..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/check_signature.tz +++ /dev/null @@ -1,8 +0,0 @@ -parameter key; -storage (pair signature string); -code { DUP; DUP; - DIP{ CDR; DUP; CAR; - DIP{CDR; H}; PAIR}; - CAR; DIP {UNPAIR}; CHECK_SIGNATURE; - IF {} {FAIL} ; - CDR; NIL operation ; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/compare.tz b/src/proto_alpha/lib_protocol/test/contracts/compare.tz deleted file mode 100644 index 698ef3e69..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/compare.tz +++ /dev/null @@ -1,9 +0,0 @@ -parameter (pair mutez mutez); -storage (list bool); -code {CAR; DUP; DUP; DUP; DUP; DIIIIIP {NIL bool}; - DIIIIP {DUP; CAR; DIP {CDR}; COMPARE; LE; CONS}; - DIIIP {DUP; CAR; DIP {CDR}; COMPARE; GE; CONS}; - DIIP{DUP; CAR; DIP {CDR}; COMPARE; LT; CONS}; - DIP {DUP; CAR; DIP {CDR}; COMPARE; GT; CONS}; - DUP; CAR; DIP {CDR}; COMPARE; EQ; CONS; - NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/concat.tz b/src/proto_alpha/lib_protocol/test/contracts/concat.tz deleted file mode 100644 index 34aafed9a..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/concat.tz +++ /dev/null @@ -1,8 +0,0 @@ -parameter string; -storage string; -code {DUP; # We're going to need both the storage and parameter - CAR; # Get the parameter - DIP{CDR}; # Get the storage value - SWAP; # Get the order we want (this is optional) - CONCAT; # Concatenate the strings - NIL operation; PAIR} # Match the calling convention diff --git a/src/proto_alpha/lib_protocol/test/contracts/concat_hello.tz b/src/proto_alpha/lib_protocol/test/contracts/concat_hello.tz deleted file mode 100644 index e290b90fb..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/concat_hello.tz +++ /dev/null @@ -1,4 +0,0 @@ -parameter (list string); -storage (list string); -code{ CAR; - MAP { PUSH @hello string "Hello "; CONCAT }; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/concat_list.tz b/src/proto_alpha/lib_protocol/test/contracts/concat_list.tz deleted file mode 100644 index f805d1b16..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/concat_list.tz +++ /dev/null @@ -1,5 +0,0 @@ -parameter (list string); -storage string; -code {CAR; PUSH string ""; SWAP; - ITER {SWAP; CONCAT}; - NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/conditionals.tz b/src/proto_alpha/lib_protocol/test/contracts/conditionals.tz deleted file mode 100644 index 16bf8e916..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/conditionals.tz +++ /dev/null @@ -1,9 +0,0 @@ -parameter (or string (option int)); -storage string; -code { CAR; # Access the storage - IF_LEFT {} # The string is on top of the stack, nothing to do - { IF_NONE { FAIL} # Fail if None - { PUSH int 0; CMPGT; # Check for negative number - IF {FAIL} # Fail if negative - {PUSH string ""}}}; # Push the empty string - NIL operation; PAIR} # Calling convention diff --git a/src/proto_alpha/lib_protocol/test/contracts/cons_twice.tz b/src/proto_alpha/lib_protocol/test/contracts/cons_twice.tz deleted file mode 100644 index 4761b23f7..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/cons_twice.tz +++ /dev/null @@ -1,9 +0,0 @@ -parameter nat; -storage (list nat); -code { DUP; # Duplicate the storage and parameter - CAR; # Extract the parameter - DIP{CDR}; # Extract the storage - DUP; # Duplicate the parameter - DIP{CONS}; # Add the first instance of the parameter to the list - CONS; # Add the second instance of the parameter to the list - NIL operation; PAIR} # Finish the calling convention diff --git a/src/proto_alpha/lib_protocol/test/contracts/contains_all.tz b/src/proto_alpha/lib_protocol/test/contracts/contains_all.tz deleted file mode 100644 index fe4160f87..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/contains_all.tz +++ /dev/null @@ -1,7 +0,0 @@ -parameter (pair (list string) (list string)); -storage (option bool); -code {CAR; DUP; CAR; DIP{CDR}; EMPTY_SET string; SWAP; - ITER {PAIR; DUP; CAR; DIP{CDR}; PUSH bool True; SWAP; UPDATE}; - PUSH bool True; SWAP; PAIR; SWAP; - ITER {PAIR; DUP; DUP; CAR; DIP{CDAR; DIP{CDDR}; DUP}; MEM; DIP{SWAP}; AND; SWAP; PAIR}; - CDR; SOME; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/create_account.tz b/src/proto_alpha/lib_protocol/test/contracts/create_account.tz deleted file mode 100644 index 816b62257..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/create_account.tz +++ /dev/null @@ -1,12 +0,0 @@ -parameter (or key_hash address) ; -storage (option (contract unit)) ; -code { CAR; - IF_LEFT - { DIP { PUSH mutez 100000000 ; PUSH bool False ; NONE key_hash }; - CREATE_ACCOUNT ; - DIP { RIGHT key_hash ; DIP { SELF ; PUSH mutez 0 } ; TRANSFER_TOKENS ; - NIL operation ; SWAP ; CONS } ; - CONS ; NONE (contract unit) ; SWAP ; PAIR } - { SELF ; ADDRESS ; SOURCE ; IFCMPNEQ { FAIL } {} ; - CONTRACT unit ; DUP ; IF_SOME { DROP } { FAIL } ; - NIL operation ; PAIR } } ; diff --git a/src/proto_alpha/lib_protocol/test/contracts/create_add1_lists.tz b/src/proto_alpha/lib_protocol/test/contracts/create_add1_lists.tz deleted file mode 100644 index c183ad1e2..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/create_add1_lists.tz +++ /dev/null @@ -1,17 +0,0 @@ -parameter unit; -storage address; -code { DROP; NIL int; # starting storage for contract - AMOUNT; # Push the starting balance - PUSH bool False; # Not spendable - DUP; # Or delegatable - NONE key_hash; # No delegate - PUSH key_hash "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"; - CREATE_CONTRACT # Create the contract - { parameter (list int) ; - storage (list int) ; - code - { CAR; - MAP {PUSH int 1; ADD}; - NIL operation; - PAIR } }; - NIL operation; SWAP; CONS; PAIR} # Ending calling convention stuff diff --git a/src/proto_alpha/lib_protocol/test/contracts/create_contract.tz b/src/proto_alpha/lib_protocol/test/contracts/create_contract.tz deleted file mode 100644 index c6664c2f2..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/create_contract.tz +++ /dev/null @@ -1,18 +0,0 @@ -parameter (or key_hash address); -storage unit; -code { CAR; - IF_LEFT - { DIP { PUSH string "dummy"; - PUSH mutez 100000000 ; PUSH bool False ; - PUSH bool False ; NONE key_hash } ; - CREATE_CONTRACT - { parameter string ; - storage string ; - code { CAR ; NIL operation ; PAIR } } ; - DIP { RIGHT key_hash ; DIP { SELF ; PUSH mutez 0 } ; TRANSFER_TOKENS ; - NIL operation ; SWAP ; CONS } ; - CONS ; UNIT ; SWAP ; PAIR } - { SELF ; ADDRESS ; SOURCE ; IFCMPNEQ { FAIL } {} ; - CONTRACT string ; IF_SOME {} { FAIL } ; - PUSH mutez 0 ; PUSH string "abcdefg" ; TRANSFER_TOKENS ; - NIL operation; SWAP; CONS ; UNIT ; SWAP ; PAIR } }; diff --git a/src/proto_alpha/lib_protocol/test/contracts/data_publisher.tz b/src/proto_alpha/lib_protocol/test/contracts/data_publisher.tz deleted file mode 100644 index 23b832dd8..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/data_publisher.tz +++ /dev/null @@ -1,8 +0,0 @@ -parameter (pair signature (pair string nat)); -storage (pair (pair key nat) string); -code { DUP; CAR; DIP{CDR; DUP}; - SWAP; DIP{DUP}; CAAR; DIP{DUP; CAR; DIP{CDR; H}}; - CHECK_SIGNATURE; - IF { CDR; DUP; DIP{CAR; DIP{CAAR}}; CDR; PUSH nat 1; ADD; - DIP{SWAP}; SWAP; PAIR; PAIR; NIL operation; PAIR} - {FAIL}} diff --git a/src/proto_alpha/lib_protocol/test/contracts/default_account.tz b/src/proto_alpha/lib_protocol/test/contracts/default_account.tz deleted file mode 100644 index db9f01156..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/default_account.tz +++ /dev/null @@ -1,5 +0,0 @@ -parameter key_hash; -storage unit; -code {DIP{UNIT}; CAR; IMPLICIT_ACCOUNT; - PUSH mutez 100000000; UNIT; TRANSFER_TOKENS; - NIL operation; SWAP; CONS; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/diff_timestamps.tz b/src/proto_alpha/lib_protocol/test/contracts/diff_timestamps.tz deleted file mode 100644 index f1991a37a..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/diff_timestamps.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (pair timestamp timestamp); -storage int; -code { CAR; DUP; CAR; DIP{CDR}; SUB; NIL operation; PAIR } diff --git a/src/proto_alpha/lib_protocol/test/contracts/dispatch.tz b/src/proto_alpha/lib_protocol/test/contracts/dispatch.tz deleted file mode 100644 index 9c185133a..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/dispatch.tz +++ /dev/null @@ -1,9 +0,0 @@ -parameter (or string (pair string (lambda unit string))); -storage (pair string (map string (lambda unit string))); -code { DUP; DIP{CDDR}; CAR; # Unpack stack - IF_LEFT { DIP{DUP}; GET; # Get lambda if it exists - IF_NONE {FAIL} {}; # Fail if it doesn't - UNIT; EXEC } # Execute the lambda - { DUP; CAR; DIP {CDR; SOME}; UPDATE; PUSH string ""}; # Update the storage - PAIR; - NIL operation; PAIR} # Calling convention diff --git a/src/proto_alpha/lib_protocol/test/contracts/empty.tz b/src/proto_alpha/lib_protocol/test/contracts/empty.tz deleted file mode 100644 index d3aecdb25..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/empty.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter unit; -storage unit; -code {CDR; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/empty_map.tz b/src/proto_alpha/lib_protocol/test/contracts/empty_map.tz deleted file mode 100644 index 9023fe847..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/empty_map.tz +++ /dev/null @@ -1,6 +0,0 @@ -storage (map string string); -parameter unit; -code {DROP; - EMPTY_MAP string string; - PUSH string "world"; SOME; PUSH string "hello"; UPDATE; - NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/exec_concat.tz b/src/proto_alpha/lib_protocol/test/contracts/exec_concat.tz deleted file mode 100644 index 6828a52fc..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/exec_concat.tz +++ /dev/null @@ -1,5 +0,0 @@ -parameter string; -storage string; -code {CAR; - LAMBDA string string {PUSH string "_abc"; SWAP; CONCAT}; - SWAP; EXEC; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/fail.tz b/src/proto_alpha/lib_protocol/test/contracts/fail.tz deleted file mode 100644 index 7f8bde252..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/fail.tz +++ /dev/null @@ -1,5 +0,0 @@ -parameter unit; -storage unit; -code - { # This contract will never accept a incoming transaction - FAIL}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/fail_amount.tz b/src/proto_alpha/lib_protocol/test/contracts/fail_amount.tz deleted file mode 100644 index 95b71c4f0..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/fail_amount.tz +++ /dev/null @@ -1,6 +0,0 @@ -# Fail if the amount transferred is less than 10 -parameter unit; -storage unit; -code { DROP; - AMOUNT; PUSH mutez 10000000; CMPGT; IF {FAIL} {}; - UNIT; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/first.tz b/src/proto_alpha/lib_protocol/test/contracts/first.tz deleted file mode 100644 index 6e47b4c00..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/first.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (list nat); -storage nat; -code{CAR; IF_CONS {DIP{DROP}} {FAIL}; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/get_map_value.tz b/src/proto_alpha/lib_protocol/test/contracts/get_map_value.tz deleted file mode 100644 index f46639649..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/get_map_value.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter string; -storage (pair (option string) (map string string)); -code {DUP; CAR; DIP{CDDR; DUP}; GET; PAIR; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/hardlimit.tz b/src/proto_alpha/lib_protocol/test/contracts/hardlimit.tz deleted file mode 100644 index 464062a52..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/hardlimit.tz +++ /dev/null @@ -1,5 +0,0 @@ -parameter unit ; -storage int ; -code { # This contract stops accepting transactions after N incoming transactions - CDR ; DUP ; PUSH int 0 ; CMPLT; IF {PUSH int -1 ; ADD} {FAIL}; - NIL operation ; PAIR} ; diff --git a/src/proto_alpha/lib_protocol/test/contracts/hash_consistency_checker.tz b/src/proto_alpha/lib_protocol/test/contracts/hash_consistency_checker.tz deleted file mode 100644 index 40db8e0d5..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/hash_consistency_checker.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (pair mutez (pair timestamp int)) ; -storage string ; -code { CAR ; H ; NIL operation ; PAIR } \ No newline at end of file diff --git a/src/proto_alpha/lib_protocol/test/contracts/hash_key.tz b/src/proto_alpha/lib_protocol/test/contracts/hash_key.tz deleted file mode 100644 index 6c7f78b4a..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/hash_key.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter key; -storage (option key_hash); -code {CAR; HASH_KEY; SOME ;NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/hash_string.tz b/src/proto_alpha/lib_protocol/test/contracts/hash_string.tz deleted file mode 100644 index 263cecb0e..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/hash_string.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter string; -storage string; -code {CAR; H; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/id.tz b/src/proto_alpha/lib_protocol/test/contracts/id.tz deleted file mode 100644 index 4eee565ca..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/id.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter string; -storage string; -code {CAR; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/if.tz b/src/proto_alpha/lib_protocol/test/contracts/if.tz deleted file mode 100644 index 4bc0e353d..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/if.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter bool; -storage (option bool); -code {CAR; IF {PUSH bool True} {PUSH bool False}; SOME; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/if_some.tz b/src/proto_alpha/lib_protocol/test/contracts/if_some.tz deleted file mode 100644 index 5c3138b22..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/if_some.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (option string); -storage string; -code { CAR; IF_SOME {} {PUSH string ""}; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/infinite_loop.tz b/src/proto_alpha/lib_protocol/test/contracts/infinite_loop.tz deleted file mode 100644 index 77cdbc48c..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/infinite_loop.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter unit; -storage unit; -code { DROP; PUSH bool True; LOOP {PUSH bool True}; UNIT; NIL operation; PAIR } diff --git a/src/proto_alpha/lib_protocol/test/contracts/insertion_sort.tz b/src/proto_alpha/lib_protocol/test/contracts/insertion_sort.tz deleted file mode 100644 index cc7ff0ed4..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/insertion_sort.tz +++ /dev/null @@ -1,25 +0,0 @@ -parameter (list int); -storage (list int); -code { CAR; # Access list - # Insert procedure - LAMBDA (pair int (list int)) - (list int) - { DUP; CDR; DIP{CAR}; # Unpack accumulator and existing list - DIIP{NIL int}; PUSH bool True; # Setup loop - LOOP { IF_CONS { SWAP; - DIP{DUP; DIIP{DUP}; DIP{CMPLT}; SWAP}; # Duplicate numbers - SWAP; - # If less than - IF { DIP{SWAP; DIP{CONS}}; PUSH bool True} - # Otherwise - { SWAP; CONS; PUSH bool False}} - # Ending case - { NIL int; PUSH bool False}}; - SWAP; CONS; SWAP; # Finish lists - LAMBDA (pair int (list int)) - (list int) - {DUP; CAR; DIP{CDR}; CONS}; - REDUCE}; - NIL int; SWAP; DIP{SWAP}; # Accumulator for reverse onto - REDUCE; # Execute reverse onto - NIL operation; PAIR} # Calling convention diff --git a/src/proto_alpha/lib_protocol/test/contracts/int_publisher.tz b/src/proto_alpha/lib_protocol/test/contracts/int_publisher.tz deleted file mode 100644 index 01820468a..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/int_publisher.tz +++ /dev/null @@ -1,17 +0,0 @@ -# (signed hash of the string, string) -parameter (option (pair signature int)); -storage (pair key int); -code {DUP; DUP; CAR; - IF_NONE {PUSH mutez 1000000; # Fee pattern from July 26 - AMOUNT; CMPLE; IF {FAIL} {}; - # Provide the data - CDR; DIP {CDDR}} - {DUP; DIP{SWAP}; SWAP; CDAR; # Move key to the top - DIP {DUP; CAR; DIP {CDR; H}}; # Arrange the new piece of data - CHECK_SIGNATURE; # Check to ensure the data is authentic - # Update data - IF {CDR; SWAP; DIP{DUP}; CDAR; PAIR} - # Revert the update. This could be replaced with FAIL - {DROP; DUP; CDR; DIP{CDDR}}}; - # Cleanup - DIP{DROP}; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/king_of_tez.tz b/src/proto_alpha/lib_protocol/test/contracts/king_of_tez.tz deleted file mode 100644 index 033ead7f1..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/king_of_tez.tz +++ /dev/null @@ -1,19 +0,0 @@ -parameter key_hash; -storage (pair timestamp (pair mutez key_hash)); -code { DUP; CDAR; - # If the time is more than 2 weeks, any amount makes you king - NOW; CMPGT; - # User becomes king of mutez - IF { CAR; AMOUNT; PAIR; NOW; PUSH int 604800; ADD; PAIR; - NIL operation } - # Check balance to see if user has paid enough to become the new king - { DUP; CDDAR; AMOUNT; CMPLT; - IF { FAIL } # user has not paid out - { CAR; DUP; - # New storage - DIP{ AMOUNT; PAIR; NOW; PUSH int 604800; ADD; PAIR }; - # Pay funds to old king - IMPLICIT_ACCOUNT; AMOUNT; UNIT; TRANSFER_TOKENS; - NIL operation; SWAP; CONS}}; - # Cleanup - PAIR }; diff --git a/src/proto_alpha/lib_protocol/test/contracts/list_id.tz b/src/proto_alpha/lib_protocol/test/contracts/list_id.tz deleted file mode 100644 index 6cd3693a1..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/list_id.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (list string); -storage (list string); -code {CAR; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/list_id_map.tz b/src/proto_alpha/lib_protocol/test/contracts/list_id_map.tz deleted file mode 100644 index 38b4493e8..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/list_id_map.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (list string); -storage (list string); -code {CAR; MAP {}; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/list_iter.tz b/src/proto_alpha/lib_protocol/test/contracts/list_iter.tz deleted file mode 100644 index df904d882..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/list_iter.tz +++ /dev/null @@ -1,5 +0,0 @@ -parameter (list int); -storage int; -code { CAR; PUSH int 1; SWAP; - ITER { MUL }; - NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/list_iter2.tz b/src/proto_alpha/lib_protocol/test/contracts/list_iter2.tz deleted file mode 100644 index caf3e5771..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/list_iter2.tz +++ /dev/null @@ -1,5 +0,0 @@ -parameter (list string); -storage string; -code { CAR; PUSH string ""; SWAP; - ITER { CONCAT }; - NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/list_map_block.tz b/src/proto_alpha/lib_protocol/test/contracts/list_map_block.tz deleted file mode 100644 index b5202dd9b..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/list_map_block.tz +++ /dev/null @@ -1,5 +0,0 @@ -parameter (list int); -storage (list int); -code { CAR; PUSH int 0; SWAP; - MAP { DIP{DUP}; ADD; DIP{PUSH int 1; ADD}}; - NIL operation; PAIR; DIP{DROP}} diff --git a/src/proto_alpha/lib_protocol/test/contracts/list_of_transactions.tz b/src/proto_alpha/lib_protocol/test/contracts/list_of_transactions.tz deleted file mode 100644 index 412112aad..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/list_of_transactions.tz +++ /dev/null @@ -1,8 +0,0 @@ -parameter unit; -storage (list (contract unit)); -code { CDR; DUP; - DIP {NIL operation}; PUSH bool True; # Setup loop - LOOP {IF_CONS { PUSH mutez 1000000; UNIT; TRANSFER_TOKENS; # Make transfer - SWAP; DIP {CONS}; PUSH bool True} # Setup for next round of loop - { NIL (contract unit); PUSH bool False}}; # Data to satisfy types and end loop - DROP; PAIR}; # Calling convention diff --git a/src/proto_alpha/lib_protocol/test/contracts/lockup.tz b/src/proto_alpha/lib_protocol/test/contracts/lockup.tz deleted file mode 100644 index a68a8628f..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/lockup.tz +++ /dev/null @@ -1,18 +0,0 @@ -parameter unit; -storage (pair timestamp (pair mutez (contract unit))); -code { CDR; # Ignore the parameter - DUP; # Duplicate the storage - CAR; # Get the timestamp - NOW; # Push the current timestamp - CMPLT; # Compare to the current time - IF {FAIL} {}; # Fail if it is too soon - DUP; # Duplicate the storage value - # this must be on the bottom of the stack for us to call transfer tokens - CDR; # Ignore the timestamp, focussing in on the tranfser data - DUP; # Duplicate the transfer information - CAR; # Get the amount of the transfer on top of the stack - DIP{CDR}; # Put the contract underneath it - UNIT; # Put the contract's argument type on top of the stack - TRANSFER_TOKENS; # Emit the transfer - NIL operation; SWAP; CONS;# Make a singleton list of internal operations - PAIR} # Pair up to meet the calling convention diff --git a/src/proto_alpha/lib_protocol/test/contracts/loop_left.tz b/src/proto_alpha/lib_protocol/test/contracts/loop_left.tz deleted file mode 100644 index 64bcc76c8..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/loop_left.tz +++ /dev/null @@ -1,7 +0,0 @@ -parameter (list string); -storage (list string); -code { CAR; NIL string; SWAP; PAIR; LEFT (list string); - LOOP_LEFT { DUP; CAR; DIP{CDR}; - IF_CONS { SWAP; DIP{CONS}; PAIR; LEFT (list string) } - { RIGHT (pair (list string) (list string)) }; }; - NIL operation; PAIR } diff --git a/src/proto_alpha/lib_protocol/test/contracts/macro_annotations.tz b/src/proto_alpha/lib_protocol/test/contracts/macro_annotations.tz deleted file mode 100644 index 368ba6a0c..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/macro_annotations.tz +++ /dev/null @@ -1,6 +0,0 @@ -parameter unit; -storage (pair @truc unit unit); -code { DROP; UNIT ; UNIT ; PAIR ; UNIT ; - DUUP @truc ; - DIP { DROP ; DROP } ; - NIL operation ; PAIR } diff --git a/src/proto_alpha/lib_protocol/test/contracts/map_caddaadr.tz b/src/proto_alpha/lib_protocol/test/contracts/map_caddaadr.tz deleted file mode 100644 index 4b6dccce9..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/map_caddaadr.tz +++ /dev/null @@ -1,4 +0,0 @@ -parameter unit; -storage (pair (pair nat (pair nat (pair (pair (pair nat mutez) nat) nat))) nat); -code { MAP_CDADDAADR { PUSH mutez 1000000 ; ADD } ; - NIL operation ; SWAP; SET_CAR }; diff --git a/src/proto_alpha/lib_protocol/test/contracts/map_car.tz b/src/proto_alpha/lib_protocol/test/contracts/map_car.tz deleted file mode 100644 index 7c50bffd6..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/map_car.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter bool; -storage (pair bool nat); -code { DUP; CAR; DIP{CDR}; SWAP; MAP_CAR { AND }; NIL operation; PAIR }; diff --git a/src/proto_alpha/lib_protocol/test/contracts/map_id.tz b/src/proto_alpha/lib_protocol/test/contracts/map_id.tz deleted file mode 100644 index ff0a3bbbf..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/map_id.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (map nat nat); -storage (map nat nat); -code { CAR ; NIL operation ; PAIR } diff --git a/src/proto_alpha/lib_protocol/test/contracts/map_iter.tz b/src/proto_alpha/lib_protocol/test/contracts/map_iter.tz deleted file mode 100644 index 1872c4906..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/map_iter.tz +++ /dev/null @@ -1,6 +0,0 @@ -parameter (map int int); -storage (pair int int); -code { CAR; PUSH int 0; DUP; PAIR; SWAP; - ITER { DIP {DUP; CAR; DIP{CDR}}; DUP; # Last instr - DIP{CAR; ADD}; SWAP; DIP{CDR; ADD}; PAIR }; - NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/map_size.tz b/src/proto_alpha/lib_protocol/test/contracts/map_size.tz deleted file mode 100644 index 4bd6417e6..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/map_size.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (map string nat); -storage nat; -code {CAR; SIZE; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/max_in_list.tz b/src/proto_alpha/lib_protocol/test/contracts/max_in_list.tz deleted file mode 100644 index 89c4955e9..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/max_in_list.tz +++ /dev/null @@ -1,9 +0,0 @@ -parameter (list int); -storage (option int); -code {CAR; DIP{NONE int}; - ITER {SWAP; - IF_NONE {SOME} - {DIP {DUP}; DUP; DIP{SWAP}; - CMPLE; IF {DROP} {DIP {DROP}}; - SOME}}; - NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/min.tz b/src/proto_alpha/lib_protocol/test/contracts/min.tz deleted file mode 100644 index cedd835bb..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/min.tz +++ /dev/null @@ -1,11 +0,0 @@ - -parameter (pair int int); -storage int; -code { CAR; # Ignore the storage - DUP; # Duplicate so we can get both the numbers passed as parameters - DUP; # Second dup so we can access the lesser number - CAR; DIP{CDR}; # Unpack the numbers on top of the stack - CMPLT; # Compare the two numbers, placing a boolean on top of the stack - IF {CAR} {CDR}; # Access the first number if the boolean was true - NIL operation; # Return no op - PAIR} # Pair the numbers satisfying the calling convention diff --git a/src/proto_alpha/lib_protocol/test/contracts/noop.tz b/src/proto_alpha/lib_protocol/test/contracts/noop.tz deleted file mode 100644 index bd19da15c..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/noop.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter unit; -storage unit; -code {CDR; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/not.tz b/src/proto_alpha/lib_protocol/test/contracts/not.tz deleted file mode 100644 index f89394072..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/not.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter bool; -storage (option bool); -code {CAR; NOT; SOME; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/or.tz b/src/proto_alpha/lib_protocol/test/contracts/or.tz deleted file mode 100644 index 89d533c44..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/or.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (pair bool bool); -storage (option bool); -code {CAR; DUP; CAR; SWAP; CDR; OR; SOME; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/originator.tz b/src/proto_alpha/lib_protocol/test/contracts/originator.tz deleted file mode 100644 index c454e230d..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/originator.tz +++ /dev/null @@ -1,16 +0,0 @@ -parameter nat ; -storage (list address) ; -code - { DUP ; CAR ; PUSH nat 0 ; CMPNEQ ; - DIP { DUP ; CAR ; DIP { CDR ; NIL operation } } ; - LOOP - { PUSH mutez 5000000 ; - PUSH bool True ; # delegatable - NONE key_hash ; # delegate - PUSH key_hash "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" ; # manager - CREATE_ACCOUNT ; - SWAP ; DIP { SWAP ; DIP { CONS } } ; - SWAP ; DIP { SWAP ; DIP { CONS } } ; - PUSH nat 1 ; SWAP ; SUB ; ABS ; - DUP ; PUSH nat 0 ; CMPNEQ } ; - DROP ; PAIR } diff --git a/src/proto_alpha/lib_protocol/test/contracts/pair_id.tz b/src/proto_alpha/lib_protocol/test/contracts/pair_id.tz deleted file mode 100644 index 3bfedf2d8..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/pair_id.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (pair bool bool); -storage (option (pair bool bool)); -code {CAR; SOME; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/pair_macro.tz b/src/proto_alpha/lib_protocol/test/contracts/pair_macro.tz deleted file mode 100644 index db8f6a8a8..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/pair_macro.tz +++ /dev/null @@ -1,4 +0,0 @@ -parameter unit; -storage unit; -code { UNIT; UNIT; UNIT; UNIT; UNIT; PAIAAIAIAIR @name; DROP; - CDR; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/parameterized_multisig.tz b/src/proto_alpha/lib_protocol/test/contracts/parameterized_multisig.tz deleted file mode 100644 index 1ad197e29..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/parameterized_multisig.tz +++ /dev/null @@ -1,24 +0,0 @@ -storage (pair bool (pair (map nat (pair bool bool)) (pair key key))); -parameter (or nat (pair signature nat)); -code { DUP; CAR; DIP{CDDR}; # Stack rangling - IF_LEFT { DIP{DUP; CAR}; GET; # Get the value stored for that index - IF_NONE { PUSH bool False} # If not referenced, reject - { DUP; CAR; DIP{CDR}; AND}; - PAIR} - { DUP; CAR; DIP{CDR; DUP; H}; PAIR; SWAP; # Create the signature pair - DIP{ DIP{DUP; CDR; DIP{CAR}; DUP}; - SWAP; CAR; DIP{DUP; UNPAIR}; CHECK_SIGNATURE }; # Check the first signature - SWAP; - # If the signature typechecked, get and update the first element of the pair - IF { DIP{DROP; SWAP; DUP}; DUP; - DIP{ GET; IF_NONE{PUSH (pair bool bool) (Pair False False)} {}; - CDR; PUSH bool True; PAIR; SOME }} - # Check the second signature - { DIP{DIP{DUP; CDR}; SWAP; DIP {UNPAIR}; CHECK_SIGNATURE}; SWAP; - IF { DUP; DIP{DIP{SWAP; DUP}; GET}; SWAP; - IF_NONE {PUSH (pair bool bool) (Pair False False)} {}; - CAR; PUSH bool True; SWAP; PAIR; SOME; SWAP} - {FAIL}}; - # Update the stored value and finish off - UPDATE; PAIR; PUSH bool False; PAIR}; - NIL operation; PAIR } diff --git a/src/proto_alpha/lib_protocol/test/contracts/queue.tz b/src/proto_alpha/lib_protocol/test/contracts/queue.tz deleted file mode 100644 index a074906dd..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/queue.tz +++ /dev/null @@ -1,24 +0,0 @@ -parameter (option string); -storage (pair (option string) (pair (pair nat nat) (map nat string))); -code { DUP; CAR; - # Retrieving an element - IF_NONE { CDDR; DUP; CAR; DIP{CDR; DUP}; DUP; - CAR; SWAP; DIP{GET}; # Check if an element is available - SWAP; - # Put NONE on stack and finish - IF_NONE { NONE string; DIP{PAIR}; PAIR} - # Reoption the element and remove the entry from the map - { SOME; - DIP{ DUP; DIP{ CAR; DIP{ NONE string }; UPDATE }; - # Increment the counter and cleanup - DUP; CAR; PUSH nat 1; ADD; DIP{ CDR }; PAIR; PAIR}; - PAIR }} - # Arrange the stack - { DIP{DUP; CDDAR; DIP{CDDDR}; DUP}; SWAP; CAR; - # Add the element to the map - DIP{ SOME; SWAP; CDR; DUP; DIP{UPDATE}; - # Increment the second number - PUSH nat 1; ADD}; - # Cleanup and finish - PAIR; PAIR; NONE string; PAIR }; - NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/reduce_map.tz b/src/proto_alpha/lib_protocol/test/contracts/reduce_map.tz deleted file mode 100644 index 3f8f17d3f..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/reduce_map.tz +++ /dev/null @@ -1,21 +0,0 @@ - -parameter (pair (lambda int int) (list int)); -storage (list int); -code { DIP{NIL int}; - CAR; - DUP; - DIP{CAR; PAIR}; # Unpack data and setup accumulator - CDR; - LAMBDA (pair int (pair (lambda int int) (list int))) - (pair (lambda int int) (list int)) - # Apply the lambda and add the new element to the list - { DUP; CDAR; - DIP{ DUP; DIP{CDAR}; DUP; - CAR; DIP{CDDR; SWAP}; EXEC; CONS}; - PAIR}; - REDUCE; CDR; DIP{NIL int}; # First reduce - LAMBDA (pair int (list int)) - (list int) - {DUP; CAR; DIP{CDR}; CONS}; - REDUCE; # Correct list order - NIL operation; PAIR} # Calling convention diff --git a/src/proto_alpha/lib_protocol/test/contracts/reentrancy.tz b/src/proto_alpha/lib_protocol/test/contracts/reentrancy.tz deleted file mode 100644 index 2e5d92060..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/reentrancy.tz +++ /dev/null @@ -1,7 +0,0 @@ -parameter unit; -storage (pair (contract unit) (contract unit)); -code { CDR; DUP; CAR; PUSH mutez 5000000; UNIT; - TRANSFER_TOKENS; - DIP {DUP; CDR; - PUSH mutez 5000000; UNIT; TRANSFER_TOKENS}; - DIIP{NIL operation};DIP{CONS};CONS;PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/ret_int.tz b/src/proto_alpha/lib_protocol/test/contracts/ret_int.tz deleted file mode 100644 index 720a99568..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/ret_int.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter unit; -storage (option nat); -code {DROP; PUSH nat 300; SOME; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/reverse.tz b/src/proto_alpha/lib_protocol/test/contracts/reverse.tz deleted file mode 100644 index 5a851f3e2..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/reverse.tz +++ /dev/null @@ -1,5 +0,0 @@ -parameter (list string); -storage (list string); -code { CAR; NIL string; SWAP; - ITER {CONS}; - NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/reverse_loop.tz b/src/proto_alpha/lib_protocol/test/contracts/reverse_loop.tz deleted file mode 100644 index d8117135c..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/reverse_loop.tz +++ /dev/null @@ -1,5 +0,0 @@ -parameter (list string); -storage (list string); -code { CAR; NIL string; SWAP; PUSH bool True; - LOOP { IF_CONS {SWAP; DIP{CONS}; PUSH bool True} {NIL string; PUSH bool False}}; - DROP; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/self.tz b/src/proto_alpha/lib_protocol/test/contracts/self.tz deleted file mode 100644 index 728cd5f1d..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/self.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter unit ; -storage (contract unit) ; -code { DROP ; SELF ; NIL operation ; PAIR } diff --git a/src/proto_alpha/lib_protocol/test/contracts/set_caddaadr.tz b/src/proto_alpha/lib_protocol/test/contracts/set_caddaadr.tz deleted file mode 100644 index db967edb2..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/set_caddaadr.tz +++ /dev/null @@ -1,5 +0,0 @@ -parameter mutez; -storage (pair (pair nat (pair nat (pair (pair (pair nat mutez) nat) nat))) nat); -code { DUP ; CAR ; SWAP ; CDR ; - SET_CADDAADR @annot ; - NIL operation ; PAIR }; diff --git a/src/proto_alpha/lib_protocol/test/contracts/set_car.tz b/src/proto_alpha/lib_protocol/test/contracts/set_car.tz deleted file mode 100644 index ec63718d6..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/set_car.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter string; -storage (pair string nat); -code { DUP; CDR; DIP{CAR}; SET_CAR @hello; NIL operation; PAIR }; diff --git a/src/proto_alpha/lib_protocol/test/contracts/set_cdr.tz b/src/proto_alpha/lib_protocol/test/contracts/set_cdr.tz deleted file mode 100644 index f4080a5e1..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/set_cdr.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter nat; -storage (pair string nat); -code { DUP; CDR; DIP{CAR}; SET_CDR @annot; NIL operation; PAIR }; diff --git a/src/proto_alpha/lib_protocol/test/contracts/set_id.tz b/src/proto_alpha/lib_protocol/test/contracts/set_id.tz deleted file mode 100644 index ede301b0e..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/set_id.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (set string); -storage (set string); -code { CAR ; NIL operation ; PAIR } diff --git a/src/proto_alpha/lib_protocol/test/contracts/set_iter.tz b/src/proto_alpha/lib_protocol/test/contracts/set_iter.tz deleted file mode 100644 index 55d8ae34a..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/set_iter.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (set int); -storage int; -code { CAR; PUSH int 0; SWAP; ITER { ADD }; NIL operation; PAIR } diff --git a/src/proto_alpha/lib_protocol/test/contracts/set_member.tz b/src/proto_alpha/lib_protocol/test/contracts/set_member.tz deleted file mode 100644 index ae97cce14..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/set_member.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter string; -storage (pair (set string) (option bool)); -code {DUP; DUP; CAR; DIP{CDAR}; MEM; SOME; DIP {CDAR}; SWAP; PAIR ; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/set_size.tz b/src/proto_alpha/lib_protocol/test/contracts/set_size.tz deleted file mode 100644 index aa055cb02..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/set_size.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (set int); -storage nat; -code {CAR; SIZE; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/spawn_identities.tz b/src/proto_alpha/lib_protocol/test/contracts/spawn_identities.tz deleted file mode 100644 index 91b062aff..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/spawn_identities.tz +++ /dev/null @@ -1,22 +0,0 @@ -parameter nat; -storage (list address); -code { DUP; - CAR; # Get the number - DIP{CDR; NIL operation}; # Put the accumulators on the stack - PUSH bool True; # Push true so we have a do while loop - LOOP { DUP; PUSH nat 0; CMPEQ; # Check if the number is 0 - IF { PUSH bool False} # End the loop - { PUSH nat 1; SWAP; SUB; ABS; # Subtract 1. The ABS is to make it back into a nat - PUSH string "init"; # Storage type - PUSH mutez 5000000; # Strating balance - PUSH bool False; DUP; # Not spendable or delegatable - NONE key_hash; - PUSH key_hash "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5"; - CREATE_CONTRACT - { parameter string ; - storage string ; - code { CAR ; NIL operation ; PAIR } } ; # Make the contract - SWAP ; DIP { SWAP ; DIP { CONS } } ; # emit the operation - SWAP ; DIP { SWAP ; DIP { CONS } } ; # add to the list - PUSH bool True}}; # Continue the loop - DROP; PAIR} # Calling convention diff --git a/src/proto_alpha/lib_protocol/test/contracts/steps_to_quota.tz b/src/proto_alpha/lib_protocol/test/contracts/steps_to_quota.tz deleted file mode 100644 index 4981864be..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/steps_to_quota.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter unit; -storage nat; -code {DROP; STEPS_TO_QUOTA; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/store_input.tz b/src/proto_alpha/lib_protocol/test/contracts/store_input.tz deleted file mode 100644 index 4eee565ca..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/store_input.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter string; -storage string; -code {CAR; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/store_now.tz b/src/proto_alpha/lib_protocol/test/contracts/store_now.tz deleted file mode 100644 index 1a868ac06..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/store_now.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter unit; -storage timestamp; -code {DROP; NOW; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/str_id.tz b/src/proto_alpha/lib_protocol/test/contracts/str_id.tz deleted file mode 100644 index f9e0710c3..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/str_id.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter string; -storage (option string); -code { CAR ; SOME ; NIL operation ; PAIR }; diff --git a/src/proto_alpha/lib_protocol/test/contracts/sub_timestamp_delta.tz b/src/proto_alpha/lib_protocol/test/contracts/sub_timestamp_delta.tz deleted file mode 100644 index f154e9524..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/sub_timestamp_delta.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (pair timestamp int); -storage timestamp; -code { CAR; DUP; CAR; DIP{CDR}; SUB; NIL operation; PAIR} diff --git a/src/proto_alpha/lib_protocol/test/contracts/subset.tz b/src/proto_alpha/lib_protocol/test/contracts/subset.tz deleted file mode 100644 index f06e1054e..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/subset.tz +++ /dev/null @@ -1,17 +0,0 @@ -parameter (pair (set string) (set string)); -storage bool; -code { CAR; DUP; CDR; DIP{CAR}; # Unpack lists - PUSH bool True; - PAIR; SWAP; # Setup accumulator - LAMBDA (pair string (pair bool (set string))) - (pair bool (set string)) - { DUP; # Unpack accumulator and input - CAR; - DIP{ CDR; DUP; DUP; CDR; - DIP{CAR; DIP{CDR}}}; - MEM; # Check membership - AND; # Combine accumulator and input - PAIR}; - REDUCE; # Reduce - CAR; # Get the accumulator value - NIL operation; PAIR} # Calling convention diff --git a/src/proto_alpha/lib_protocol/test/contracts/swap_left_right.tz b/src/proto_alpha/lib_protocol/test/contracts/swap_left_right.tz deleted file mode 100644 index d5650c034..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/swap_left_right.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (or bool string); -storage (or string bool); -code {CAR; IF_LEFT {RIGHT string} {LEFT bool}; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/take_my_money.tz b/src/proto_alpha/lib_protocol/test/contracts/take_my_money.tz deleted file mode 100644 index bb502d041..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/take_my_money.tz +++ /dev/null @@ -1,9 +0,0 @@ -parameter key_hash; -storage unit; -code { CAR; IMPLICIT_ACCOUNT; # Create an account for the recipient of the funds - DIP{UNIT}; # Push a value of the storage type below the contract - PUSH mutez 1000000; # The person can have a ꜩ - UNIT; # Push the contract's argument type - TRANSFER_TOKENS; # Run the transfer - NIL operation; SWAP; CONS; - PAIR }; # Cleanup and put the return values diff --git a/src/proto_alpha/lib_protocol/test/contracts/tez_add_sub.tz b/src/proto_alpha/lib_protocol/test/contracts/tez_add_sub.tz deleted file mode 100644 index 39eba1d16..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/tez_add_sub.tz +++ /dev/null @@ -1,5 +0,0 @@ -parameter (pair mutez mutez); -storage (option (pair mutez mutez)); -code {CAR; DUP; DUP; CAR; DIP{CDR}; ADD; - DIP{DUP; CAR; DIP{CDR}; SUB}; - PAIR; SOME; NIL operation; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/transfer_amount.tz b/src/proto_alpha/lib_protocol/test/contracts/transfer_amount.tz deleted file mode 100644 index 973c64f04..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/transfer_amount.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter unit; -storage mutez; -code { DROP; AMOUNT; NIL operation; PAIR }; diff --git a/src/proto_alpha/lib_protocol/test/contracts/transfer_to.tz b/src/proto_alpha/lib_protocol/test/contracts/transfer_to.tz deleted file mode 100644 index 599b4dae1..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/transfer_to.tz +++ /dev/null @@ -1,5 +0,0 @@ -parameter (contract unit); -storage unit; -code { CAR; DIP{UNIT}; PUSH mutez 100000000; UNIT; - TRANSFER_TOKENS; - NIL operation; SWAP; CONS; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/contracts/unpair_macro.tz b/src/proto_alpha/lib_protocol/test/contracts/unpair_macro.tz deleted file mode 100644 index 6a33e2290..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/unpair_macro.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter unit; -storage unit; -code { UNIT; UNIT; UNIT; UNIT; PAIAAIR; UNPAIAAIR; DROP; DROP; DROP; DROP; CAR; NIL operation; PAIR } diff --git a/src/proto_alpha/lib_protocol/test/contracts/weather_insurance.tz b/src/proto_alpha/lib_protocol/test/contracts/weather_insurance.tz deleted file mode 100644 index 895763f78..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/weather_insurance.tz +++ /dev/null @@ -1,18 +0,0 @@ -# (pair signed_weather_data actual_level) -parameter (pair (signature @sig) (nat @nat)); -# (pair (under_key over_key) (pair weather_service_key (pair rain_level days_in_future))) -storage (pair (pair (contract @lt unit) - (contract @geq unit)) - (pair nat key)); -code { DUP; DUP; - CAR; MAP_CDR{H}; - SWAP; CDDDR; DIP {UNPAIR} ; CHECK_SIGNATURE; # Check if the data has been correctly signed - ASSERT; # If signature is not correct, end the execution - DUP; DUP; DUP; DIIIP{CDR}; # Place storage type on bottom of stack - DIIP{CDAR}; # Place contracts below numbers - DIP{CADR}; # Get actual rain - CDDAR; # Get rain threshold - CMPLT; IF {CAR @winner} {CDR @winner}; # Select contract to receive tokens - BALANCE; UNIT ; TRANSFER_TOKENS; # Setup and execute transfer - NIL operation ; SWAP ; CONS ; - PAIR }; diff --git a/src/proto_alpha/lib_protocol/test/contracts/xor.tz b/src/proto_alpha/lib_protocol/test/contracts/xor.tz deleted file mode 100644 index ab8dcf57d..000000000 --- a/src/proto_alpha/lib_protocol/test/contracts/xor.tz +++ /dev/null @@ -1,3 +0,0 @@ -parameter (pair bool bool); -storage (option bool); -code {CAR; DUP; CAR; DIP{CDR}; XOR; SOME; NIL operation ; PAIR}; diff --git a/src/proto_alpha/lib_protocol/test/helpers/account.ml b/src/proto_alpha/lib_protocol/test/helpers/account.ml new file mode 100644 index 000000000..ed36d9612 --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/helpers/account.ml @@ -0,0 +1,58 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Proto_alpha + +type t = { + pkh : Signature.Public_key_hash.t ; + pk : Signature.Public_key.t ; + sk : Signature.Secret_key.t ; +} +type account = t + +let known_accounts = Signature.Public_key_hash.Table.create 17 + +let new_account () = + let (pkh, pk, sk) = Signature.generate_key () in + let account = { pkh ; pk ; sk } in + Signature.Public_key_hash.Table.add known_accounts pkh account ; + account + +let add_account ({ pkh ; _ } as account) = + Signature.Public_key_hash.Table.add known_accounts pkh account + +let dictator_account = new_account () + +let find pkh = + try return (Signature.Public_key_hash.Table.find known_accounts pkh) + with Not_found -> + failwith "Missing account: %a" Signature.Public_key_hash.pp pkh + +let find_alternate pkh = + let exception Found of t in + try + Signature.Public_key_hash.Table.iter + (fun pkh' account -> + if not (Signature.Public_key_hash.equal pkh pkh') then + raise (Found account)) + known_accounts ; + raise Not_found + with Found account -> account + +let dummy_account = new_account () + +let generate_accounts n : (t * Tez_repr.t) list = + Signature.Public_key_hash.Table.clear known_accounts ; + let amount = Tez_repr.of_mutez_exn 4_000_000_000_000L in + List.map (fun _ -> + let (pkh, pk, sk) = Signature.generate_key () in + let account = { pkh ; pk ; sk } in + Signature.Public_key_hash.Table.add known_accounts pkh account ; + account, amount) + (0--(n-1)) diff --git a/src/proto_alpha/lib_protocol/test/helpers/account.mli b/src/proto_alpha/lib_protocol/test/helpers/account.mli new file mode 100644 index 000000000..23bfb1f61 --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/helpers/account.mli @@ -0,0 +1,31 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Proto_alpha + +type t = { + pkh : Signature.Public_key_hash.t ; + pk : Signature.Public_key.t ; + sk : Signature.Secret_key.t ; +} +type account = t + +val dictator_account: account +val dummy_account: account + +val new_account: unit -> account + +val add_account : t -> unit + +val find: Signature.Public_key_hash.t -> t tzresult Lwt.t +val find_alternate: Signature.Public_key_hash.t -> t + +(** [generate_accounts n] : generates [n] random accounts with + 4.000.000.000 tz and add them to the global account state *) +val generate_accounts : int -> (t * Tez_repr.t) list diff --git a/src/proto_alpha/lib_protocol/test/helpers/assert.ml b/src/proto_alpha/lib_protocol/test/helpers/assert.ml new file mode 100644 index 000000000..ef1ee7144 --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/helpers/assert.ml @@ -0,0 +1,97 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Proto_alpha + +let error ~loc v f = + match v with + | Error err when List.exists f err -> + return () + | Ok _ -> + failwith "Unexpected successful result (%s)" loc + | Error err -> + failwith "@[Unexpected error (%s): %a@]" loc pp_print_error err + +let proto_error ~loc v f = + error ~loc v + (function + | Alpha_environment.Ecoproto_error err -> f err + | _ -> false) + +let equal ~loc (cmp : 'a -> 'a -> bool) msg pp a b = + if not (cmp a b) then + failwith "@[@[[%s]@] - @[%s : %a is not equal to %a@]@]" loc msg pp a pp b + else + return () + +let not_equal ~loc (cmp : 'a -> 'a -> bool) msg pp a b = + if cmp a b then + failwith "@[@[[%s]@] - @[%s : %a is equal to %a@]@]" loc msg pp a pp b + else + return () + +let equal_tez ~loc (a:Alpha_context.Tez.t) (b:Alpha_context.Tez.t) = + let open Alpha_context in + equal ~loc Tez.(=) "Tez aren't equal" Tez.pp a b + +let not_equal_tez ~loc (a:Alpha_context.Tez.t) (b:Alpha_context.Tez.t) = + let open Alpha_context in + not_equal ~loc Tez.(=) "Tez are equal" Tez.pp a b + +let equal_int ~loc (a:int) (b:int) = + equal ~loc (=) "Integers aren't equal" Format.pp_print_int a b + +let not_equal_int ~loc (a:int) (b:int) = + not_equal ~loc (=) "Integers are equal" Format.pp_print_int a b + +let equal_bool ~loc (a:bool) (b:bool) = + equal ~loc (=) "Booleans aren't equal" Format.pp_print_bool a b + +let not_equal_bool ~loc (a:bool) (b:bool) = + not_equal ~loc (=) "Booleans are equal" Format.pp_print_bool a b + + +open Context +(* Some asserts for account operations *) + +(** [balance_is b c amount] checks that the current balance of contract [c] is + [amount]. + Default balance type is [Main], pass [~kind] with [Deposit], [Fees] or + [Rewards] for the others. *) +let balance_is ~loc b contract ?(kind = Contract.Main) expected = + Contract.balance b contract ~kind >>=? fun balance -> + equal_tez ~loc balance expected + +(** [balance_was_operated ~operand b c old_balance amount] checks that the + current balance of contract [c] is [operand old_balance amount] and + returns the current balance. + Default balance type is [Main], pass [~kind] with [Deposit], [Fees] or + [Rewards] for the others. *) +let balance_was_operated ~(operand) ~loc b contract ?(kind = Contract.Main) old_balance amount = + operand old_balance amount |> + Alpha_environment.wrap_error |> Lwt.return >>=? fun expected -> + balance_is ~loc b contract ~kind expected + +let balance_was_credited = balance_was_operated ~operand:Alpha_context.Tez.(+?) + +let balance_was_debited = balance_was_operated ~operand:Alpha_context.Tez.(-?) + + +(* debug *) + +let print_balances ctxt id = + Contract.balance ~kind:Main ctxt id >>=? fun main -> + Contract.balance ~kind:Deposit ctxt id >>=? fun deposit -> + Contract.balance ~kind:Fees ctxt id >>=? fun fees -> + Contract.balance ~kind:Rewards ctxt id >>|? fun rewards -> + Format.printf "\nMain: %s\nDeposit: %s\nFees: %s\nRewards: %s\n" + (Alpha_context.Tez.to_string main) + (Alpha_context.Tez.to_string deposit) + (Alpha_context.Tez.to_string fees) + (Alpha_context.Tez.to_string rewards) diff --git a/src/proto_alpha/lib_protocol/test/helpers/block.ml b/src/proto_alpha/lib_protocol/test/helpers/block.ml new file mode 100644 index 000000000..8dd6967cb --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/helpers/block.ml @@ -0,0 +1,380 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Proto_alpha +module Proto_Nonce = Nonce (* Renamed otherwise is masked by Alpha_context *) +open Alpha_context + +(* This type collects a block and the context that results from its application *) +type t = { + hash : Block_hash.t ; + header : Block_header.t ; + operations : Operation.t list ; + context : Tezos_protocol_environment_memory.Context.t ; +} +type block = t + +let rpc_context block = + let operations_hashes = + lazy [ List.map Operation.hash block.operations ] in + Lwt.return { + Alpha_environment.Updater.block_hash = block.hash ; + block_header = (Block_header.raw block.header) ; + operation_hashes = (fun () -> Lwt.return (Lazy.force operations_hashes)) ; + operations = (fun () -> Lwt.return [ List.map Operation.raw block.operations ]) ; + context = block.context ; + } + +let rpc_ctxt = + new Alpha_environment.proto_rpc_context_of_directory + rpc_context Proto_alpha.rpc_services + +(******** Policies ***********) + +(* Policies are functions that take a block and return a tuple + [(account, level, timestamp)] for the [forge_header] function. *) + +(* This type is used only to provide a simpler interface to the exterior. *) +type baker_policy = + | By_priority of int + | By_account of public_key_hash + | Excluding of public_key_hash list + +let get_next_baker_by_priority priority block = + Alpha_services.Delegate.Baker.rights rpc_ctxt + ~max_priority:(priority+1) block >>=? fun (_, bakers) -> + let pkh, timestamp = List.nth bakers priority in + return (pkh, priority, timestamp) + +let get_next_baker_by_account pkh block = + Alpha_services.Delegate.Baker.rights rpc_ctxt + ~max_priority:30 block >>=? fun (_, bakers) -> + let ((_pkh, timestamp), priority) = Test_utils.findi + (fun (pkh', _) -> Signature.Public_key_hash.equal pkh pkh') + bakers in + return (pkh, priority, timestamp) + +let get_next_baker_excluding excludes block = + Alpha_services.Delegate.Baker.rights rpc_ctxt + ~max_priority:((List.length excludes)+10) block >>=? fun (_, bakers) -> + let (pkh,timestamp),priority = Test_utils.findi + (fun (pkh, _) -> not (List.mem pkh excludes)) + bakers in + return (pkh, priority, timestamp) + +let dispatch_policy = function + | By_priority p -> get_next_baker_by_priority p + | By_account a -> get_next_baker_by_account a + | Excluding al -> get_next_baker_excluding al + +let get_next_baker ?(policy = By_priority 0) = dispatch_policy policy + +module Forge = struct + + type header = { + shell : Block_header.shell_header ; + contents : Block_header.contents ; + } + + let default_proof_of_work_nonce = + MBytes.create Constants.proof_of_work_nonce_size + + let make_header + ?(proof_of_work_nonce = default_proof_of_work_nonce) + ~priority ~seed_nonce_hash + ~level ~predecessor ~timestamp ~fitness ~operations_hash () = + let contents = Block_header.{ + priority ; + proof_of_work_nonce ; + seed_nonce_hash ; + } + in + let shell = Tezos_base.Block_header.{ + level ; + predecessor ; + timestamp ; + fitness ; + operations_hash ; + (* We don't care of the following values, only the shell validates them. *) + proto_level = 0 ; + validation_passes = 0 ; + context = Context_hash.zero ; + } + in + { shell ; contents } + + let set_seed_nonce_hash seed_nonce_hash { shell ; contents } = + { shell ; contents = { contents with seed_nonce_hash } } + + let sign_header { shell ; contents } pred = + (* Finds the baker that should sign from the header *) + let baker_of_a_block header = + let priority = header.contents.priority in + Alpha_services.Delegate.Baker.rights rpc_ctxt + ~max_priority:(priority+1) pred >>=? fun (_, bakers) -> + let pkh, _ = List.nth bakers priority in + Account.find pkh + in + baker_of_a_block { shell ; contents } >>=? fun delegate -> + let unsigned_bytes = + Data_encoding.Binary.to_bytes_exn + Block_header.unsigned_encoding + (shell, contents) in + let signature = Signature.sign ~watermark:Signature.Block_header delegate.sk unsigned_bytes in + Block_header.{ shell ; protocol_data = { contents ; signature } } |> + return + + let forge_header + ?(policy = By_priority 0) + ?(operations = []) pred = + dispatch_policy policy pred >>=? fun (_, priority, timestamp) -> + let level = Int32.succ pred.header.shell.level in + begin + match Fitness_repr.to_int64 pred.header.shell.fitness with + | Ok old_fitness -> + return (Fitness_repr.from_int64 + (Int64.add (Int64.of_int 1) old_fitness)) + | Error _ -> assert false + end >>=? fun fitness -> + begin + Alpha_services.Context.next_level (rpc_ctxt) pred >>|? function + | { expected_commitment = true } -> Some (fst (Proto_Nonce.generate ())) + | { expected_commitment = false } -> None + end >>=? fun seed_nonce_hash -> + let hashes = List.map Operation.hash operations in + let operations_hash = Operation_list_list_hash.compute + [Operation_list_hash.compute hashes] in + let header = make_header + ~priority ~level ~predecessor:pred.hash ~timestamp ~fitness + ~seed_nonce_hash ~operations_hash () in + return header + + (* compatibility only, needed by incremental *) + let contents + ?(proof_of_work_nonce = default_proof_of_work_nonce) + ?(priority = 0) ?seed_nonce_hash () = + { Block_header.priority ; + proof_of_work_nonce ; + seed_nonce_hash ; + } + +end + +(********* Genesis creation *************) + +(* Hard-coded context key *) +let protocol_param_key = [ "protocol_parameters" ] + +let check_constants_consistency constants = + let open Constants_repr in + let { blocks_per_cycle ; blocks_per_commitment ; + blocks_per_roll_snapshot ; _ } = constants in + Error_monad.unless (blocks_per_commitment <= blocks_per_cycle) + (fun () -> failwith "Inconsistent constants : blocks per commitment must be \ + less than blocks per cycle") >>=? fun () -> + Error_monad.unless (blocks_per_cycle >= blocks_per_roll_snapshot) + (fun () -> failwith "Inconsistent constants : blocks per cycle \ + must be superior than blocks per roll snapshot") >>=? + return + +let initial_context + constants + header + commitments + initial_accounts + security_deposit_ramp_up_cycles + no_reward_cycles + = + let bootstrap_accounts = + List.map (fun (Account.{ pk = public_key ; _ }, amount) -> + Parameters_repr.{ public_key ; amount } + ) initial_accounts + in + let json = + Data_encoding.Json.construct + Parameters_repr.encoding + Parameters_repr.{ + bootstrap_accounts ; + commitments ; + constants ; + security_deposit_ramp_up_cycles ; + no_reward_cycles ; + } + in + let proto_params = + Data_encoding.Binary.to_bytes_exn Data_encoding.json json + in + Tezos_protocol_environment_memory.Context.( + set empty protocol_param_key proto_params + ) >>= fun ctxt -> + Main.init ctxt header + >|= Alpha_environment.wrap_error >>=? fun { context; _ } -> + return context + +let genesis + ?(preserved_cycles = Constants_repr.default.preserved_cycles) + ?(blocks_per_cycle = Constants_repr.default.blocks_per_cycle) + ?(blocks_per_commitment = Constants_repr.default.blocks_per_commitment) + ?(blocks_per_roll_snapshot = Constants_repr.default.blocks_per_roll_snapshot) + ?(blocks_per_voting_period = Constants_repr.default.blocks_per_voting_period) + ?(time_between_blocks = Constants_repr.default.time_between_blocks) + ?(first_free_baking_slot = Constants_repr.default.first_free_baking_slot) + ?(endorsers_per_block = Constants_repr.default.endorsers_per_block) + ?(hard_gas_limit_per_operation = Constants_repr.default.hard_gas_limit_per_operation) + ?(hard_gas_limit_per_block = Constants_repr.default.hard_gas_limit_per_block) + ?(proof_of_work_threshold = Int64.(neg one)) + ?(dictator_pubkey = Constants_repr.default.dictator_pubkey) + ?(max_operation_data_length = Constants_repr.default.max_operation_data_length) + ?(tokens_per_roll = Constants_repr.default.tokens_per_roll) + ?(michelson_maximum_type_size = Constants_repr.default.michelson_maximum_type_size) + ?(seed_nonce_revelation_tip = Constants_repr.default.seed_nonce_revelation_tip) + ?(origination_burn = Constants_repr.default.origination_burn) + ?(block_security_deposit = Constants_repr.default.block_security_deposit) + ?(endorsement_security_deposit = Constants_repr.default.endorsement_security_deposit) + ?(block_reward = Constants_repr.default.block_reward) + ?(endorsement_reward = Constants_repr.default.endorsement_reward) + ?(cost_per_byte = Constants_repr.default.cost_per_byte) + ?(hard_storage_limit_per_operation = Constants_repr.default.hard_storage_limit_per_operation) + ?(hard_storage_limit_per_block = Constants_repr.default.hard_storage_limit_per_block) + ?(commitments = []) + ?(security_deposit_ramp_up_cycles = None) + ?(no_reward_cycles = None) + (initial_accounts : (Account.t * Tez_repr.t) list) + = + if initial_accounts = [] then + Pervasives.failwith "Must have one account with a roll to bake"; + + (* Check there is at least one roll *) + begin try + let open Test_utils in + fold_left_s (fun acc (_, amount) -> + Alpha_environment.wrap_error @@ + Tez_repr.(+?) acc amount >>?= fun acc -> + if acc >= tokens_per_roll then + raise Exit + else return acc + ) Tez_repr.zero initial_accounts >>=? fun _ -> + failwith "Insufficient tokens in initial accounts to create one roll" + with Exit -> return () + end >>=? fun () -> + + let constants : Constants_repr.parametric = { + preserved_cycles ; + blocks_per_cycle ; + blocks_per_commitment ; + blocks_per_roll_snapshot ; + blocks_per_voting_period ; + time_between_blocks ; + first_free_baking_slot ; + endorsers_per_block ; + hard_gas_limit_per_operation ; + hard_gas_limit_per_block ; + proof_of_work_threshold ; + dictator_pubkey ; + max_operation_data_length ; + tokens_per_roll ; + michelson_maximum_type_size ; + seed_nonce_revelation_tip ; + origination_burn ; + block_security_deposit ; + endorsement_security_deposit ; + block_reward ; + endorsement_reward ; + cost_per_byte ; + hard_storage_limit_per_operation ; + hard_storage_limit_per_block ; + } in + check_constants_consistency constants >>=? fun () -> + + let hash = + Block_hash.of_b58check_exn "BLockGenesisGenesisGenesisGenesisGenesisCCCCCeZiLHU" + in + let header = + Forge.make_header + ~level:0l + ~predecessor:hash + ~timestamp:Time.epoch + ~fitness: (Fitness_repr.from_int64 0L) + ~priority: 0 + ~seed_nonce_hash:None + ~operations_hash: Operation_list_list_hash.zero + () + in + initial_context + constants + header.shell + commitments + initial_accounts + security_deposit_ramp_up_cycles + no_reward_cycles + >>=? fun context -> + let block = + { hash ; + header = { + shell = header.shell ; + protocol_data = { + contents = header.contents ; + signature = Signature.zero ; + } ; + }; + operations = [] ; + context ; + } + in + return block + +(********* Baking *************) + +let apply (header:Forge.header) ?(operations = []) pred = + Forge.sign_header header pred >>=? fun header -> + begin + let open Alpha_environment.Error_monad in + Proto_alpha.Main.begin_application + ~predecessor_context: pred.context + ~predecessor_fitness: pred.header.shell.fitness + ~predecessor_timestamp: pred.header.shell.timestamp + header >>=? fun vstate -> + fold_left_s + (fun vstate op -> + Proto_alpha.apply_operation vstate op >>=? fun (state, _result) -> + return state) + vstate operations >>=? fun vstate -> + Proto_alpha.Main.finalize_block vstate >>=? fun (validation, _result) -> + return validation.context + end >|= Alpha_environment.wrap_error >>|? fun context -> + let hash = Block_header.hash header in + { hash ; header ; operations ; context } + +let bake ?policy ?operation ?operations pred = + let operations = + match operation,operations with + | Some op, Some ops -> Some (op::ops) + | Some op, None -> Some [op] + | None, Some ops -> Some ops + | None, None -> None + in + Forge.forge_header ?policy ?operations pred >>=? fun header -> + apply header ?operations pred + +(* This function is duplicated from Context to avoid a cyclic dependency *) +let get_constants b = + Alpha_services.Constants.all rpc_ctxt b + +(********** Cycles ****************) + +let bake_n ?policy n b = + Error_monad.fold_left_s + (fun b _ -> bake ?policy b) b (1 -- n) + +let bake_until_cycle_end ?policy b = + get_constants b >>=? fun Constants.{ parametric = { blocks_per_cycle } } -> + let current_level = b.header.shell.level in + let current_level = Int32.rem current_level blocks_per_cycle in + let delta = Int32.sub blocks_per_cycle current_level in + bake_n ?policy (Int32.to_int delta) b diff --git a/src/proto_alpha/lib_protocol/test/helpers/block.mli b/src/proto_alpha/lib_protocol/test/helpers/block.mli new file mode 100644 index 000000000..bf1ada329 --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/helpers/block.mli @@ -0,0 +1,115 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Proto_alpha +open Alpha_context + +type t = { + hash : Block_hash.t ; + header : Block_header.t ; + operations : Operation.t list ; + context : Tezos_protocol_environment_memory.Context.t ; (** Resulting context *) +} +type block = t + +val rpc_ctxt: t Alpha_environment.RPC_context.simple + +(** Policies to select the next baker *) +type baker_policy = + | By_priority of int + | By_account of public_key_hash + | Excluding of public_key_hash list + +(** Returns (account, priority, timestamp) of the next baker given + a policy, defaults to By_priority 0. *) +val get_next_baker: + ?policy:baker_policy -> + t -> (public_key_hash * int * Time.t) tzresult Lwt.t + +module Forge : sig + + val contents: + ?proof_of_work_nonce:MBytes.t -> + ?priority:int -> + ?seed_nonce_hash: Nonce_hash.t -> + unit -> Block_header.contents + + type header + + (** Forges a correct header following the policy. + The header can then be modified and applied with [apply]. *) + val forge_header: + ?policy:baker_policy -> + ?operations: Operation.t list -> + t -> header tzresult Lwt.t + + (** Sets seed_nonce_hash of a header *) + val set_seed_nonce_hash: + Nonce_hash.t option -> + header -> header + +end + +(** [genesis accounts] : generates an initial block with the + given constants [] and initializes [accounts] with their + associated amounts. +*) +val genesis: + ?preserved_cycles:int -> + ?blocks_per_cycle:int32 -> + ?blocks_per_commitment:int32 -> + ?blocks_per_roll_snapshot:int32 -> + ?blocks_per_voting_period:int32 -> + ?time_between_blocks:Period_repr.t list -> + ?first_free_baking_slot:int -> + ?endorsers_per_block:int -> + ?hard_gas_limit_per_operation:Z.t -> + ?hard_gas_limit_per_block:Z.t -> + ?proof_of_work_threshold:int64 -> + ?dictator_pubkey:public_key -> + ?max_operation_data_length:int -> + ?tokens_per_roll:Tez_repr.tez -> + ?michelson_maximum_type_size:int -> + ?seed_nonce_revelation_tip:Tez_repr.tez -> + ?origination_burn:Tez_repr.tez -> + ?block_security_deposit:Tez_repr.tez -> + ?endorsement_security_deposit:Tez_repr.tez -> + ?block_reward:Tez_repr.tez -> + ?endorsement_reward:Tez_repr.tez -> + ?cost_per_byte: Tez_repr.t -> + ?hard_storage_limit_per_operation: Int64.t -> + ?hard_storage_limit_per_block: Int64.t -> + ?commitments:Commitment_repr.t list -> + ?security_deposit_ramp_up_cycles: int option -> + ?no_reward_cycles: int option -> + (Account.t * Tez_repr.tez) list -> block tzresult Lwt.t + +(** Applies a header and its operations to a block and obtains a new block *) +val apply: + Forge.header -> + ?operations: Operation.t list -> + t -> t tzresult Lwt.t + +(** + [bake b] returns a block [b'] which has as predecessor block [b]. + Optional parameter [policy] allows to pick the next baker in several ways. + This function bundles together [forge_header] and [apply]. +*) +val bake: + ?policy: baker_policy -> + ?operation: Operation.t -> + ?operations: Operation.t list -> + t -> t tzresult Lwt.t + +(** Bakes [n] blocks. *) +val bake_n : ?policy:baker_policy -> int -> t -> block tzresult Lwt.t + +(** Given a block [b] at level [l] bakes enough blocks to complete a cycle, + that is [blocks_per_cycle - (l % blocks_per_cycle)]. *) +val bake_until_cycle_end : ?policy:baker_policy -> t -> t tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/test/helpers/context.ml b/src/proto_alpha/lib_protocol/test/helpers/context.ml new file mode 100644 index 000000000..5ae342546 --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/helpers/context.ml @@ -0,0 +1,148 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Proto_alpha +open Alpha_context + +type t = + | B of Block.t + | I of Incremental.t + +let branch = function + | B b -> b.hash + | I i -> (Incremental.predecessor i).hash + +let level = function + | B b -> b.header.shell.level + | I i -> (Incremental.level i) + +let get_level ctxt = + level ctxt + |> Raw_level.of_int32 + |> Alpha_environment.wrap_error + |> Lwt.return + +let rpc_ctxt = object + method call_proto_service0 : + 'm 'q 'i 'o. + ([< RPC_service.meth ] as 'm, Alpha_environment.RPC_context.t, Alpha_environment.RPC_context.t, 'q, 'i, 'o) RPC_service.t -> + t -> 'q -> 'i -> 'o tzresult Lwt.t = + fun s pr q i -> + match pr with + | B b -> Block.rpc_ctxt#call_proto_service0 s b q i + | I b -> Incremental.rpc_ctxt#call_proto_service0 s b q i + method call_proto_service1 : + 'm 'a 'q 'i 'o. + ([< RPC_service.meth ] as 'm, Alpha_environment.RPC_context.t, Alpha_environment.RPC_context.t * 'a, 'q, 'i, 'o) RPC_service.t -> + t -> 'a -> 'q -> 'i -> 'o tzresult Lwt.t = + fun s pr a q i -> + match pr with + | B bl -> Block.rpc_ctxt#call_proto_service1 s bl a q i + | I bl -> Incremental.rpc_ctxt#call_proto_service1 s bl a q i + method call_proto_service2 : + 'm 'a 'b 'q 'i 'o. + ([< RPC_service.meth ] as 'm, Alpha_environment.RPC_context.t, (Alpha_environment.RPC_context.t * 'a) * 'b, 'q, 'i, 'o) RPC_service.t -> + t -> 'a -> 'b -> 'q -> 'i -> 'o tzresult Lwt.t = + fun s pr a b q i -> + match pr with + | B bl -> Block.rpc_ctxt#call_proto_service2 s bl a b q i + | I bl -> Incremental.rpc_ctxt#call_proto_service2 s bl a b q i + method call_proto_service3 : + 'm 'a 'b 'c 'q 'i 'o. + ([< RPC_service.meth ] as 'm, Alpha_environment.RPC_context.t, ((Alpha_environment.RPC_context.t * 'a) * 'b) * 'c, 'q, 'i, 'o) RPC_service.t -> + t -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o tzresult Lwt.t = + fun s pr a b c q i -> + match pr with + | B bl -> Block.rpc_ctxt#call_proto_service3 s bl a b c q i + | I bl -> Incremental.rpc_ctxt#call_proto_service3 s bl a b c q i +end + +let get_endorsers ctxt = + Alpha_services.Delegate.Endorser.rights + rpc_ctxt ctxt >>=? fun (_level, endorsers) -> + return endorsers + +let get_endorser ctxt slot = + Alpha_services.Delegate.Endorser.rights + ~max_priority:(slot+1) rpc_ctxt ctxt >>=? fun (_level, endorsers) -> + try return (List.nth endorsers slot) + with _ -> + failwith "Failed to lookup endorsers for ctxt %a, slot %d." + Block_hash.pp_short (branch ctxt) slot + +let get_bakers ctxt = + Alpha_services.Delegate.Baker.rights rpc_ctxt ~max_priority:30 ctxt >>=? fun (_, bakers) -> + return (List.map fst bakers) + +let get_constants b = + Alpha_services.Constants.all rpc_ctxt b + +module Contract = struct + + let pkh c = Alpha_context.Contract.is_implicit c |> function + | Some p -> return p + | None -> failwith "pkh: only for implicit contracts" + + type balance_kind = Main | Deposit | Fees | Rewards + + let balance ?(kind = Main) ctxt contract = + begin match kind with + | Main -> + Alpha_services.Contract.balance rpc_ctxt ctxt contract + | _ -> + match Alpha_context.Contract.is_implicit contract with + | None -> invalid_arg "get_balance: no frozen accounts for an originated contract." + | Some pkh -> + Alpha_services.Delegate.frozen_balances rpc_ctxt ctxt pkh >>|? + fun Delegate.({deposit ; fees ; rewards }) -> + begin match kind with + | Deposit -> deposit + | Fees -> fees + | Rewards -> rewards + | _ -> invalid_arg "get_balance: pass Main, Deposit, Fees or Rewards." + end + end + + let counter ctxt contract = + Alpha_services.Contract.counter rpc_ctxt ctxt contract + + let manager ctxt contract = + Alpha_services.Contract.manager rpc_ctxt ctxt contract >>=? fun pkh -> + Account.find pkh + + let is_manager_key_revealed ctxt contract = + Alpha_services.Contract.manager_key rpc_ctxt ctxt contract >>=? fun (_, res) -> + return (res <> None) + +end + +let init + ?(slow=false) + ?endorsers_per_block + ?commitments + n = + let accounts = Account.generate_accounts n in + let contracts = List.map (fun (a, _) -> + Alpha_context.Contract.implicit_contract Account.(a.pkh)) accounts in + begin + if slow then + Block.genesis + ?endorsers_per_block + ?commitments + accounts + else + Block.genesis + ~blocks_per_cycle:32l + ~blocks_per_commitment:4l + ~blocks_per_roll_snapshot:8l + ?endorsers_per_block + ?commitments + accounts + end >>=? fun blk -> + return (blk, contracts) diff --git a/src/proto_alpha/lib_protocol/test/helpers/context.mli b/src/proto_alpha/lib_protocol/test/helpers/context.mli new file mode 100644 index 000000000..88776aae7 --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/helpers/context.mli @@ -0,0 +1,53 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Proto_alpha +open Alpha_context + +type t = + | B of Block.t + | I of Incremental.t + +val branch: t -> Block_hash.t + +val get_level: t -> Raw_level.t tzresult Lwt.t + +val get_endorsers: t -> public_key_hash list tzresult Lwt.t + +val get_endorser: t -> int -> public_key_hash tzresult Lwt.t + +val get_bakers: t -> public_key_hash list tzresult Lwt.t + +(** Returns all the constants of the protocol *) +val get_constants: t -> Constants.t tzresult Lwt.t + +module Contract : sig + + val pkh: Contract.t -> public_key_hash tzresult Lwt.t + + type balance_kind = Main | Deposit | Fees | Rewards + + (** Returns the balance of a contract, by default the main balance. + If the contract is implicit the frozen balances are available too: + deposit, fees ot rewards. *) + val balance: ?kind:balance_kind -> t -> Contract.t -> Tez.t tzresult Lwt.t + + val counter: t -> Contract.t -> int32 tzresult Lwt.t + val manager: t -> Contract.t -> Account.t tzresult Lwt.t + val is_manager_key_revealed: t -> Contract.t -> bool tzresult Lwt.t + +end + +(** [init n] : returns an initial block with [n] initialized accounts + and the associated implicit contracts *) +val init: + ?slow: bool -> + ?endorsers_per_block:int -> + ?commitments:Commitment_repr.t list -> + int -> (Block.t * Alpha_context.Contract.t list) tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_account.ml b/src/proto_alpha/lib_protocol/test/helpers/helpers_account.ml deleted file mode 100644 index 889613d8f..000000000 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_account.ml +++ /dev/null @@ -1,105 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - - -open Proto_alpha.Error_monad -open Proto_alpha.Alpha_context - -type account = { - hpub : Signature.Public_key_hash.t ; - pub : Signature.Public_key.t ; - ppk : Signature.Secret_key.t ; - contract : Contract.contract -} -type t = account - -let bootstrap_accounts = - let pubs = [ - "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav"; - "edpktzNbDAUjUk697W7gYg2CRuBQjyPxbEg8dLccYYwKSKvkPvjtV9"; - "edpkuTXkJDGcFd5nh6VvMz8phXxU3Bi7h6hqgywNFi1vZTfQNnS1RV"; - "edpkuFrRoDSEbJYgxRtLx2ps82UdaYc1WwfS9sE11yhauZt5DgCHbU"; - "edpkv8EUUH68jmo3f7Um5PezmfGrRF24gnfLpH3sVNwJnV5bVCxL2n"; - ] in - let ppks = [ - "edskRuR1azSfboG86YPTyxrQgosh5zChf5bVDmptqLTb5EuXAm9\ - rsnDYfTKhq7rDQujdn5WWzwUMeV3agaZ6J2vPQT58jJAJPi"; - "edskRkJz4Rw2rM5NtabEWMbbg2bF4b1nfFajaqEuEk4SgU7eeDby\ - m9gVQtBTbYo32WUg2zb5sNBkD1whRN7zX43V9bftBbtaKc"; - "edskS3qsqsNgdjUqeMsVcEwBn8dkZ5iDRz6aF21KhcCtRiAkWByp\ - USbicccR4Vgqm9UdW2Vabuos6seezqgbXTrmcbLUG4rdAC"; - "edskRg9qcPqaVQa6jXWNMU5p71tseSuR7NzozgqZ9URsVDi81wTyP\ - JdFSBdeakobyHUi4Xgu61jgKRQvkhXrPmEdEUfiqfiJFL"; - "edskS7rLN2Df3nbS1EYvwJbWo4umD7yPM1SUeX7gp1WhCVpMFXjcC\ - yM58xs6xsnTsVqHQmJQ2RxoAjJGedWfvFmjQy6etA3dgZ"; - ] in - let pubs = List.map Signature.Public_key.of_b58check_exn pubs in - let ppks = List.map Signature.Secret_key.of_b58check_exn ppks in - let keys = List.combine pubs ppks in - let aux (pub, ppk) : account = - let hpub = Signature.Public_key.hash pub in { - pub ; - ppk ; - hpub ; - contract = Contract.implicit_contract hpub - } - in List.map aux keys - -let new_account () : account = - let (hpub, pub, ppk) = Signature.generate_key () in - let contract = Contract.implicit_contract hpub in - {hpub ; pub ; ppk ; contract} - -let init_amount = 10000 - -let init_account ~(tc : context) account = - Contract.credit - tc - account.contract - @@ Helpers_cast.tez_of_int init_amount - >>=? fun context -> return (account, context) - -let make_account ~(tc : context) = - let account = new_account () in - init_account ~tc account - -let make_accounts ~(tc : context) n = - let rec aux tc n acc = - if (n = 0) then - return (acc, tc) - else - make_account ~tc >>=? fun (account, tc) -> - aux tc (n - 1) @@ account :: acc - in - aux tc n [] - -let make_2_accounts ~(tc : context) = - make_account ~tc >>=? fun (src, tc) -> - make_account ~tc >>=? fun (dst, tc) -> - return ((src, dst), tc) - -let make_4_accounts ~(tc : context) = - make_account ~tc >>=? fun (a, tc) -> - make_account ~tc >>=? fun (b, tc) -> - make_account ~tc >>=? fun (c, tc) -> - make_account ~tc >>=? fun (d, tc) -> - return ((a, b, c, d), tc) - -let display_account ~tc account = - Contract.get_balance tc account.contract >>= function - | Ok balance -> ( - Helpers_logger.lwt_debug - "Account %a : (%a tz)" - Signature.Public_key_hash.pp account.hpub - Tez.pp balance - )| Error _ -> Helpers_logger.lwt_debug "Error in balance" - -let display_accounts ~tc accounts = - Helpers_logger.lwt_debug "Got accounts" >>= fun () -> - Lwt_list.iter_s (display_account ~tc) accounts diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_account.mli b/src/proto_alpha/lib_protocol/test/helpers/helpers_account.mli deleted file mode 100644 index 1a966743b..000000000 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_account.mli +++ /dev/null @@ -1,64 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -open Proto_alpha -open Alpha_context - -(** Facilities to deal with accounts , bootstrap accounts and make new - accounts *) - -(** Explicit account type *) -type account = { - hpub : Signature.Public_key_hash.t; - pub : Signature.Public_key.t; - ppk : Signature.Secret_key.t; - contract : - Contract.contract; -} -type t = account - -(** Bootstrap accounts of the sandbox *) -val bootstrap_accounts : account list - -(** Generates a new (pub , ppk) pair and the associated default_contract *) -val new_account : unit -> account - -(** Amount of cents in a new account *) -val init_amount : int - -(** Credits a new account *) -val init_account : - tc:context -> account -> - (account * context) proto_tzresult Lwt.t - -(** Generates a new account and credits it *) -val make_account : - tc:context -> - (account * context) proto_tzresult Lwt.t - -(** Generates a list of new accounts and credits them *) -val make_accounts : - tc:context -> int -> - (account list * context) proto_tzresult Lwt.t - -(** Better typed "make_accounts tc 2" *) -val make_2_accounts : - tc:context -> - ((account * account) * context) proto_tzresult Lwt.t - -(** Better typed "make_accounts tc 4" *) -val make_4_accounts : - tc:context -> - ((t * t * t * t) * context) proto_tzresult Lwt.t - -(** Debug : Displays an account and its balance *) -val display_account : tc:context -> account -> unit Lwt.t - -(** Debug : Displays several accounts and their balances *) -val display_accounts : tc:context -> account list -> unit Lwt.t diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_apply.ml b/src/proto_alpha/lib_protocol/test/helpers/helpers_apply.ml deleted file mode 100644 index ec52535f9..000000000 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_apply.ml +++ /dev/null @@ -1,116 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -open Proto_alpha.Error_monad -open Proto_alpha.Apply_operation_result - -let extract_result = function - | Sourced_operation_result (Manager_operations_result { operation_results }) -> - List.fold_left - (fun (acc, err) (_, r) -> - match r with - | Applied (Transaction_result { originated_contracts } - | Origination_result { originated_contracts }) -> - (originated_contracts @ acc, err) - | Applied Reveal_result - | Applied Delegation_result - | Skipped -> (acc, err) - | Failed errs -> (acc, Some errs)) - ([], None) operation_results - | _ -> ([], None) - -let bind_result (tc, result) = - match extract_result result with - | _, Some err -> - Lwt.return (Error err) - | contracts, None -> - return (contracts, tc) - -let operation - ~tc ?(src: Helpers_account.t option) - pred_block_hash op_sh proto_op = - return @@ Helpers_operation.apply_of_proto src op_sh proto_op >>=? fun operation -> - let hash = Proto_alpha.Alpha_context.Operation.hash operation in - Proto_alpha.Apply.apply_operation - tc Readable - pred_block_hash - hash - operation - >>=? bind_result - - -let transaction ~tc ?(fee = 0) - pbh opsh src (dst: Helpers_account.t) - amount = - Helpers_operation.transaction_full - src dst.contract - (Helpers_cast.cents_of_int amount) - ~fee: (Helpers_cast.cents_of_int fee) - (Proto_alpha.Alpha_context.Constants.hard_gas_limit_per_operation tc) - @@ Helpers_cast.ctxt_of_tc tc - >>=? fun protop -> - operation ~tc ~src pbh opsh protop - - -let transaction_pred ?tc ~(pred: Helpers_block.result) (src, dst, amount, fee) = - let tc = Option.unopt ~default:pred.tezos_context tc in - let fee = Option.unopt ~default:10 fee in - transaction ~tc ~fee pred.hash (Helpers_block.get_op_header_res pred) src dst amount - - -let script_origination - ~tc pbh opsh script src amount = - Helpers_operation.script_origination_full - script src (Helpers_cast.cents_of_int amount) - (Proto_alpha.Alpha_context.Constants.hard_gas_limit_per_operation tc) - @@ Helpers_cast.ctxt_of_tc tc - >>=? fun protop -> operation ~tc ~src pbh opsh protop - - -let origination - ~tc ?(spendable = true) ?(fee = 0) ?(delegatable = true) - pbh opsh src amount = - Helpers_operation.origination_full - src ~spendable ~delegatable - (Helpers_cast.cents_of_int amount) ~fee:(Helpers_cast.tez_of_int fee) - (Proto_alpha.Alpha_context.Constants.hard_gas_limit_per_operation tc) - @@ Helpers_cast.ctxt_of_tc tc - >>=? fun protop -> - operation ~tc ~src pbh opsh protop - - -let script_origination_pred - ?tc ~(pred: Helpers_block.result) (script, src, amount) = - let tc = Option.unopt ~default:pred.tezos_context tc in - script_origination ~tc pred.hash (Helpers_block.get_op_header_res pred) (Some script) src amount - - -let origination_pred - ?tc ~(pred: Helpers_block.result) (src, amount, spendable, delegatable, fee) = - let tc = Option.unopt ~default:pred.tezos_context tc in - origination ~tc ~spendable ~fee ~delegatable - pred.hash - (Helpers_block.get_op_header_res pred) - src amount - - -let delegation ~tc ?(fee = 0) pbh opsh src delegate = - Helpers_operation.delegation_full - src delegate ~fee:(Helpers_cast.cents_of_int fee) - @@ Helpers_cast.ctxt_of_tc tc - >>=? fun protop -> - operation ~tc ~src pbh opsh protop - - -let delegation_pred - ?tc ~(pred: Helpers_block.result) (src, delegate, fee) = - let tc = Option.unopt ~default:pred.tezos_context tc in - delegation ~tc ~fee pred.hash (Helpers_block.get_op_header_res pred) src delegate - - diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_apply.mli b/src/proto_alpha/lib_protocol/test/helpers/helpers_apply.mli deleted file mode 100644 index 0bf74fb9a..000000000 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_apply.mli +++ /dev/null @@ -1,58 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -(** Functions to build and apply operations *) - -open Proto_alpha -open Alpha_context - -val operation : - tc:context -> ?src:Helpers_account.t -> - Block_hash.t -> Tezos_base.Operation.shell_header -> Operation.contents -> - (Contract.contract list * context) proto_tzresult Lwt.t - -val transaction : - tc:context -> ?fee:int -> Block_hash.t -> - Tezos_base.Operation.shell_header -> Helpers_account.t -> Helpers_account.t -> int -> - (Contract.contract list * context) proto_tzresult Lwt.t - -val transaction_pred : - ?tc:t -> pred:Helpers_block.result -> - Helpers_account.t * Helpers_account.t * int * int option -> - (Contract.contract list * context) proto_tzresult Lwt.t - -val script_origination : - tc:context -> Block_hash.t -> Tezos_base.Operation.shell_header -> - Script.t option -> Helpers_account.t -> int -> - (Contract.contract list * context) proto_tzresult Lwt.t - -val origination : - tc:context -> ?spendable:bool -> ?fee:int -> - ?delegatable:bool -> Block_hash.t -> Tezos_base.Operation.shell_header -> - Helpers_account.t -> int -> - (Contract.contract list * context) proto_tzresult Lwt.t - -val script_origination_pred : - ?tc:t -> pred:Helpers_block.result -> Script.t * Helpers_account.t * int -> - (Contract.contract list * context) proto_tzresult Lwt.t - -val origination_pred : - ?tc:t -> pred:Helpers_block.result -> - Helpers_account.t * int * bool * bool * int -> - (Contract.contract list * context) proto_tzresult Lwt.t - -val delegation : - tc:context -> ?fee:int -> Block_hash.t -> - Tezos_base.Operation.shell_header -> Helpers_account.t -> public_key_hash -> - (Contract.contract list * context) proto_tzresult Lwt.t - -val delegation_pred : - ?tc:t -> pred:Helpers_block.result -> - Helpers_account.t * public_key_hash * int -> - (Contract.contract list * context) proto_tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_assert.ml b/src/proto_alpha/lib_protocol/test/helpers/helpers_assert.ml deleted file mode 100644 index 521fa45a0..000000000 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_assert.ml +++ /dev/null @@ -1,222 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -open Proto_alpha -open Alpha_context - -module Assert = struct - let fail expected given msg = - Format.kasprintf Pervasives.failwith - "@[%s@ expected: %s@ got: %s@]" msg expected given - let fail_msg fmt = Format.kasprintf (fail "" "") fmt - - let default_printer _ = "" - - let equal ?(eq=(=)) ?(prn=default_printer) ?(msg="") x y = - if not (eq x y) then fail (prn x) (prn y) msg - - let is_true ?(msg="") x = - if not x then fail "true" "false" msg - - let is_false ?(msg="") x = - if x then fail "false" "true" msg - - let is_some ?(msg="") x = - if x = None then fail "Some _" "None" msg - - let is_none ?(msg="") x = - if x <> None then fail "None" "Some _" msg - - let make_equal e p = equal ~eq:e ~prn:p - let string_of_string s = Printf.sprintf "%S" s - let equal_string = make_equal (=) string_of_string - - -end - -let wrap_result = Alpha_environment.wrap_error - -let wrap = fun x -> Lwt.return @@ wrap_result x - -let (>>=??) x y = x >>= wrap >>=? y - -let (>>??) x y = wrap_result x >>? y - -let (>>?=) x y = x >>= wrap >>= y - -open Proto_alpha.Error_monad - -let tmp_map f lst = - let rec aux acc = function - | [] -> ok acc - | hd :: tl -> - f hd >>? fun fhd -> (aux (fhd :: acc) tl) - in - aux [] lst - - -let ok ?msg = function - | Ok x -> return x - | Error errs -> - Helpers_logger.log_error "Error : %a" pp @@ List.hd errs ; - Assert.is_true ~msg:(Option.unopt ~default:"not ok" msg) false ; - fail @@ List.hd errs - - -let ok_contract ?msg x = - ok x >>=? fun (((_, errs), _) as x) -> - Assert.is_none ?msg errs ; - return x - - -exception No_error - -let no_error ?msg = function - | Ok x -> x - | Error _ -> - Assert.is_true - ~msg: (Option.unopt ~default:"yes error" msg) - false ; - raise No_error - - -let equal_pkh ?msg pkh1 pkh2 = - let eq pkh1 pkh2 = - match pkh1, pkh2 with - | None, None -> true - | Some pkh1, Some pkh2 -> - Signature.Public_key_hash.equal pkh1 pkh2 - | _ -> false in - let prn = function - | None -> "none" - | Some pkh -> Signature.Public_key_hash.to_b58check pkh in - Assert.equal ?msg ~prn ~eq pkh1 pkh2 - -let equal_int64 ?msg = - Assert.equal - ~eq: Int64.equal - ~prn: Int64.to_string - ~msg: (Option.unopt ~default:"int64_equal" msg) - - -let equal_int ?msg = - Assert.equal - ~eq: (=) - ~prn: string_of_int - ~msg: (Option.unopt ~default:"int_equal" msg) - - - -let equal_tez ?msg = - Assert.equal - ~eq: Tez .(=) - ~prn: Tez.to_string - ~msg: (Option.unopt ~default:"tez_equal" msg) - - -let equal_balance ~tc ?msg (contract, expected_balance) = - Contract.get_balance tc contract >>=? fun balance -> - return @@ - equal_tez - expected_balance balance - ~msg: (Option.unopt ~default:"balance_equal" msg) - - -let equal_cents_balance ~tc ?msg (contract, cents_balance) = - equal_balance - ~tc - ~msg: (Option.unopt ~default:"equal_cents_balance" msg) - (contract, Helpers_cast.cents_of_int cents_balance) - -let ecoproto_error f = function - | Alpha_environment.Ecoproto_error error -> f error - | _ -> false - -let contain_error ?(msg="") ~f = function - | Ok _ -> Assert.fail "Error _" "Ok _" msg - | Error error when not (List.exists f error) -> - let error_str = Format.asprintf "%a" Tezos_error_monad.Error_monad.pp_print_error error in - Assert.fail "" error_str msg - | _ -> () - -let generic_economic_error ~msg = - contain_error ~msg ~f: (ecoproto_error (fun _ -> true)) - -let economic_error ~msg f = - contain_error ~msg ~f: (ecoproto_error f) - -let ill_typed_data_error ~msg = - let aux = function - | Proto_alpha.Script_tc_errors.Ill_typed_data _ -> true - | _ -> false in - economic_error ~msg aux - -let ill_typed_return_error ~msg = - let aux = function - | Proto_alpha.Script_tc_errors.Bad_return _ -> true - | _ -> false in - economic_error ~msg aux - -let double_endorsement_evidence ~msg = - let aux = function - | Proto_alpha.Apply.Duplicate_endorsement(_) -> true - | _ -> false - in - economic_error ~msg aux - -let contain_error_alpha ?msg ~f = function - | Ok _ -> () - | Error errs -> - if (not @@ List.exists f errs) - then Assert.is_true - ~msg:(Option.unopt ~default:"yes error" msg) false - - -let unknown_contract ~msg = - let f = function - | Proto_alpha.Raw_context.Storage_error _ -> true - | Proto_alpha.Contract_storage.Empty_implicit_contract _ -> true - | _ -> false - in - contain_error_alpha ~msg ~f - - -let non_existing_contract ~msg = - contain_error_alpha ~msg ~f: (function - | Proto_alpha.Contract_storage.Non_existing_contract _ -> true - | _ -> false) - - -let balance_too_low ~msg = - contain_error_alpha ~msg ~f: (function - | Contract.Balance_too_low _ -> true - | _ -> false) - - -let non_spendable ~msg = - contain_error ~msg ~f: begin ecoproto_error (function - | Proto_alpha.Contract_storage.Unspendable_contract _ -> true - | error -> - Helpers_logger.debug "Actual error: %a" pp error ; - false) - end - -let inconsistent_pkh ~msg = - contain_error ~msg ~f: begin ecoproto_error (function - | Proto_alpha.Contract_storage.Inconsistent_hash _ -> true - | _ -> false) - end - -let non_delegatable ~msg = - contain_error ~msg ~f: begin ecoproto_error (function - | Proto_alpha.Delegate_storage.Non_delegatable_contract _ -> true - | _ -> false) - end - -include Assert diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_assert.mli b/src/proto_alpha/lib_protocol/test/helpers/helpers_assert.mli deleted file mode 100644 index c6dcfbbb0..000000000 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_assert.mli +++ /dev/null @@ -1,89 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -open Proto_alpha -open Alpha_context - -val fail : string -> string -> string -> 'a -(** Raises [Failed] with the passed parameters - (expected value, actual value, and message). *) - -val fail_msg : ('a, Format.formatter, unit, 'b) format4 -> 'a -(** [fail_msg m] is equivalent to [fail "" "" m]. *) - -val equal_string : ?msg:string -> string -> string -> unit -(** Same as [equal], but specialized for [string] values. *) - -val equal : ?eq:('a -> 'a -> bool) -> ?prn:('a -> string) -> ?msg:string -> 'a -> 'a -> unit - -(** Functions capturing common assertion scenarios and error monads helpers *) - -(** Converts a tzresult from the Environment's error monad to a tzresult of the - top level error monad *) -val wrap_result : 'a proto_tzresult -> 'a tzresult - -(** Converts a tzresult Lwt.t from the Environment's error monad to a tzresult Lwt.t - of the top level error monad *) -val wrap : 'a proto_tzresult -> 'a tzresult Lwt.t - -(** Binds a top level error monad function with an Environment's error monad - tzresult Lwt.t *) -val ( >>=?? ) : - 'a proto_tzresult Lwt.t -> ('a -> 'b tzresult Lwt.t) -> 'b tzresult Lwt.t - -(** Binds a top level error monad function with an Environment's error monad - tzresult *) -val ( >>?? ) : 'a proto_tzresult -> ('a -> 'b tzresult) -> 'b tzresult - -(** Partially binds a top level error monad function with an Environment's - error monad tzresult *) -val ( >>?= ) : 'a proto_tzresult Lwt.t -> ('a tzresult -> 'b Lwt.t) -> 'b Lwt.t - -val tmp_map : ('a -> 'b proto_tzresult) -> 'a list -> 'b list proto_tzresult - -val ok : ?msg:string -> 'a proto_tzresult -> 'a proto_tzresult Lwt.t - -val ok_contract : ?msg:string -> - (('a * 'b option) * 'c) proto_tzresult -> - (('a * 'b option) * 'c) proto_tzresult Lwt.t - -exception No_error - -val no_error : ?msg:string -> ('a, 'b) result -> 'a -val equal_pkh : - ?msg:string -> Signature.Public_key_hash.t option -> - Signature.Public_key_hash.t option -> unit -val equal_int64 : ?msg:string -> Int64.t -> Int64.t -> unit -val equal_int : ?msg:string -> int -> int -> unit -val equal_tez : ?msg:string -> Tez.t -> Tez.t -> unit -val equal_balance : - tc:context -> ?msg:string -> - Contract.contract * Tez.t -> - unit proto_tzresult Lwt.t -val equal_cents_balance : - tc:context -> ?msg:string -> - Contract.contract * int -> - unit proto_tzresult Lwt.t -val ecoproto_error : - (proto_error -> bool) -> error -> bool - -val generic_economic_error : msg:string -> 'a tzresult -> unit -val economic_error : - msg:string -> (proto_error -> bool) -> 'a tzresult -> unit -val ill_typed_data_error : msg:string -> 'a tzresult -> unit -val ill_typed_return_error : msg:string -> 'a tzresult -> unit -val double_endorsement_evidence : msg:string -> 'a tzresult -> unit -val contain_error_alpha : - ?msg:string -> f:('a -> bool) -> ('b, 'a list) result -> unit -val unknown_contract : msg:string -> 'a proto_tzresult -> unit -val non_existing_contract : msg:string -> 'a proto_tzresult -> unit -val balance_too_low : msg:string -> 'a proto_tzresult -> unit -val non_spendable : msg:string -> 'a tzresult -> unit -val inconsistent_pkh : msg:string -> 'a tzresult -> unit -val non_delegatable : msg:string -> 'a tzresult -> unit diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_block.ml b/src/proto_alpha/lib_protocol/test/helpers/helpers_block.ml deleted file mode 100644 index 180a3973d..000000000 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_block.ml +++ /dev/null @@ -1,195 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -open Proto_alpha -open Error_monad - -type shell_header = Block_header.shell_header -type tezos_header = Block_header.t -type protocol_data = Proto_alpha.Alpha_context.Block_header.protocol_data -type contents = Proto_alpha.Alpha_context.Block_header.contents -type operation_header = Operation.shell_header - -type init_block = { - pred_block_hash : Block_hash.t ; - pred_shell_header : shell_header ; - protocol_data : contents ; - op_header : operation_header ; - sourced_operations : (Proto_alpha.Main.operation * Helpers_account.t) list ; - operation_hashs : Operation_hash.t list ; - protocol_data_bytes : MBytes.t ; - timestamp : Time.t ; - level : Int32.t ; - context : Tezos_protocol_environment_memory.Context.t -} - -type result = { - tezos_header : tezos_header ; - hash : Block_hash.t ; - level : Int32.t ; - validation : Tezos_protocol_environment_memory.validation_result ; - tezos_context : Proto_alpha.Alpha_context.t -} - -let get_op_header_res (res : result) : operation_header = { - branch = res.hash -} - -let get_protocol_data priority commit : Alpha_context.Block_header.contents = { - priority ; - proof_of_work_nonce = Helpers_crypto.generate_proof_of_work_nonce (); - seed_nonce_hash = - if commit then - Some (Proto_alpha.Alpha_context.Nonce.hash @@ Helpers_crypto.generate_seed_nonce ()) - else - None -} - -let get_op_header pbh : operation_header = { - branch = pbh -} - - -let make_sourced_operation op_header (proto_operation, source) = - Helpers_operation.main_of_proto source op_header proto_operation >>? fun (a, b) -> - ok ((a, source), b) - - -let init (pred_shell_header : shell_header) pred_block_hash - level priority src_protops context = - let op_header : operation_header = - get_op_header pred_block_hash in - Helpers_assert.tmp_map (make_sourced_operation op_header) src_protops >>? fun src_ops_hashs -> - let (sourced_operations, operation_hashs) = List.split src_ops_hashs in - let protocol_data = get_protocol_data priority true in - let protocol_data_bytes = - Data_encoding.Binary.to_bytes_exn - Proto_alpha.Alpha_context.Block_header.contents_encoding - protocol_data - in - let timestamp = - Time.add - pred_shell_header.timestamp - @@ Int64.mul 60L @@ Int64.of_int (priority + 1) - in - ok { - pred_block_hash ; - pred_shell_header ; - protocol_data ; - op_header ; - protocol_data_bytes ; - sourced_operations ; - operation_hashs ; - timestamp ; - level ; - context - } - - -let init_of_result ?(priority = 15) ~(res : result) ~ops = - init - res.tezos_header.shell - res.hash - res.level - priority - ops - res.validation.context - - -let get_level opt_msg = - let msg = Option.unopt ~default: "level 1" opt_msg in - let parts = String.split_on_char ',' msg in - let level_part = List.hd parts in - let parts = String.split_on_char ' ' level_part in - let level_str = List.nth parts 1 in - Int32.of_int @@ int_of_string level_str - - -let get_header_hash - (init_block : init_block) - (validation_result : Tezos_protocol_environment_memory.validation_result) - : result tzresult Lwt.t - = - let op_hashs = init_block.operation_hashs in - let hash = Operation_list_list_hash.compute - [Operation_list_hash.compute op_hashs] in - let level = Int32.succ init_block.pred_shell_header.level in - let timestamp = init_block.timestamp in - let shell_header = { - init_block.pred_shell_header with - level ; - predecessor = init_block.pred_block_hash ; - operations_hash = hash ; - timestamp ; - fitness = validation_result.fitness - } in - let tezos_header : tezos_header = { - shell = shell_header ; - protocol_data = init_block.protocol_data_bytes - } in - Proto_alpha.Alpha_context.prepare - validation_result.context - ~level - ~timestamp - ~fitness: validation_result.fitness - >>=? fun tezos_context -> - let hash = Block_header.hash tezos_header in - return { - tezos_header ; - hash ; - validation = validation_result ; - level ; - tezos_context - } - - -let begin_construction_pre (init_block: init_block) = - Proto_alpha.Main.begin_construction - ~predecessor_context: init_block.context - ~predecessor_timestamp: init_block.pred_shell_header.timestamp - ~predecessor_level: init_block.level - ~predecessor_fitness: init_block.pred_shell_header.fitness - ~predecessor: init_block.pred_block_hash - ~timestamp: init_block.timestamp - ~protocol_data: - (Alpha_context.Block_header.{ contents = init_block.protocol_data ; - signature = Signature.zero }) - () - - -let make init_block = - let (operations,_) = List.split init_block.sourced_operations in - begin_construction_pre init_block >>=? fun vs -> - Proto_alpha.Error_monad.fold_left_s - (fun ctxt op -> Main.apply_operation ctxt op >>=? fun (ctxt, _) -> return ctxt) - vs - operations - >>=? fun ctxt -> - Main.finalize_block ctxt >>=? fun (ctxt, _) -> - get_header_hash init_block ctxt - - -let make_init psh pbh lvl prio ops ctxt = - Lwt.return @@ init psh pbh lvl prio ops ctxt >>=? make - - -let of_res ?priority ?(ops =[]) ~(res: result) () = - Lwt.return @@ init_of_result ?priority ~res ~ops >>=? make - - -let endorsement - psh pbh level priority src ctxt slot = - make_init - psh pbh (Alpha_context.Raw_level.to_int32 level) priority - [Helpers_operation.endorsement_full pbh ~slot level, src] - ctxt - - -let empty psh pbh level prio ctxt = - make_init psh pbh level prio [] ctxt diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_block.mli b/src/proto_alpha/lib_protocol/test/helpers/helpers_block.mli deleted file mode 100644 index 8812c4f0d..000000000 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_block.mli +++ /dev/null @@ -1,81 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -open Proto_alpha - -(** Representation of blocks independent from the State module *) - -type shell_header = Block_header.shell_header -type tezos_header = Block_header.t -type protocol_data = Alpha_context.Block_header.protocol_data -type contents = Proto_alpha.Alpha_context.Block_header.contents -type operation_header = Operation.shell_header - -(** Block before application *) -type init_block = { - pred_block_hash : Block_hash.t; - pred_shell_header : shell_header; - protocol_data : contents; - op_header : operation_header; - sourced_operations : - (Main.operation * Helpers_account.t) list; - operation_hashs : Operation_hash.t list; - protocol_data_bytes : MBytes.t; - timestamp : Time.t; - level : Int32.t; - context : Tezos_protocol_environment_memory.Context.t -} - -(** Result of the application of a block *) -type result = { - tezos_header : tezos_header; - hash : Block_hash.t; - level : Int32.t; - validation : Tezos_protocol_environment_memory.validation_result; - tezos_context : Alpha_context.t; -} -val get_op_header_res : result -> operation_header -val get_protocol_data : int -> bool -> contents -val get_op_header : Block_hash.t -> operation_header -val make_sourced_operation : - Operation.shell_header -> - Alpha_context.Operation.contents * - Helpers_account.t -> - ((Proto_alpha.Main.operation * Helpers_account.t) * Operation_hash.t) proto_tzresult -val init : - shell_header -> Block_hash.t -> Int32.t -> int -> - (Alpha_context.Operation.contents * Helpers_account.t) list -> - Context.t -> init_block proto_tzresult -val init_of_result : - ?priority:int -> res:result -> - ops:(Alpha_context.Operation.contents * Helpers_account.t) list -> - init_block proto_tzresult -val get_level : string option -> int32 -val get_header_hash : - init_block -> Tezos_protocol_environment_memory.validation_result -> - result proto_tzresult Lwt.t -val begin_construction_pre : - init_block -> Main.validation_state proto_tzresult Lwt.t -val make : init_block -> result proto_tzresult Lwt.t -val make_init : - shell_header -> Block_hash.t -> Int32.t -> int -> - (Alpha_context.Operation.contents * Helpers_account.t) list -> - Context.t -> result proto_tzresult Lwt.t -val of_res : - ?priority:int -> - ?ops:(Alpha_context.Operation.contents * Helpers_account.t) list -> - res:result -> - unit -> result proto_tzresult Lwt.t -val endorsement : - shell_header -> Block_hash.t -> Alpha_context.Raw_level.t -> int -> - Helpers_account.t -> Context.t -> int -> - result proto_tzresult Lwt.t -val empty : - shell_header -> Block_hash.t -> Int32.t -> int -> - Context.t -> result proto_tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_cast.ml b/src/proto_alpha/lib_protocol/test/helpers/helpers_cast.ml deleted file mode 100644 index 6ae71a724..000000000 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_cast.ml +++ /dev/null @@ -1,40 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -open Proto_alpha.Alpha_context - -exception Tez_error - -let tez_of_int x = Option.unopt_exn Tez_error @@ ( - match (Tez.( *?) Tez.one (Int64.of_int x)) with - | Error _ -> None - | Ok x -> Some x - ) - -let cents_of_int x = Option.unopt_exn Tez_error @@ ( - match (Tez.( *?) Tez.one_cent (Int64.of_int x)) with - | Error _ -> None - | Ok x -> Some x - ) - -let tez_add x y = match Tez.(+?) x y with - | Ok x -> x - | Error _ -> raise Tez_error - - -let tez_add_int x y = tez_add x @@ tez_of_int y - -let tez_sub x y = match Tez.(-?) x y with - | Ok x -> x - | Error _ -> raise Tez_error - - -let tez_sub_int x y = tez_add x @@ tez_of_int y - -let ctxt_of_tc tc = (finalize tc).context diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_cast.mli b/src/proto_alpha/lib_protocol/test/helpers/helpers_cast.mli deleted file mode 100644 index 429bd3a9b..000000000 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_cast.mli +++ /dev/null @@ -1,27 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -open Proto_alpha.Alpha_context - -exception Tez_error - -(** Common casts between Alpha_context types *) - -val tez_of_int : int -> Tez.tez -val cents_of_int : int -> Tez.tez - -(** Tez.(+?) with a top - level error instead *) -val tez_add : Tez.tez -> Tez.tez -> Tez.tez -val tez_add_int : Tez.tez -> int -> Tez.tez - -(** Tez.(-?) with a top - level error instead *) -val tez_sub : Tez.tez -> Tez.tez -> Tez.tez -val tez_sub_int : Tez.tez -> int -> Tez.tez -val ctxt_of_tc : context -> Tezos_protocol_environment_memory.Context.t - diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_crypto.ml b/src/proto_alpha/lib_protocol/test/helpers/helpers_crypto.ml deleted file mode 100644 index 368ca66f8..000000000 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_crypto.ml +++ /dev/null @@ -1,19 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc.< contact@tezos.com > *) -(* *) -(* All rights reserved.No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -open Proto_alpha.Alpha_context - -let generate_proof_of_work_nonce () = - Rand.generate Constants.proof_of_work_nonce_size - -let generate_seed_nonce () = - match Nonce.of_bytes @@ - Rand.generate Constants.nonce_length with - | Error _ -> assert false - | Ok nonce -> nonce diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_crypto.mli b/src/proto_alpha/lib_protocol/test/helpers/helpers_crypto.mli deleted file mode 100644 index 688f0000d..000000000 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_crypto.mli +++ /dev/null @@ -1,13 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc.< contact@tezos.com > *) -(* *) -(* All rights reserved.No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -(** Extension of the Sodium module with helpers functions *) - -val generate_proof_of_work_nonce : unit -> MBytes.t -val generate_seed_nonce : unit -> Proto_alpha.Alpha_context.Nonce.nonce diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_init.ml b/src/proto_alpha/lib_protocol/test/helpers/helpers_init.ml deleted file mode 100644 index e7a19b79f..000000000 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_init.ml +++ /dev/null @@ -1,91 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -open Proto_alpha -open Error_monad - -let sandbox_parameters = - match Data_encoding.Json.from_string {json| -{ - "genesis_pubkey": - "edpkuSLWfVU1Vq7Jg9FucPyKmma6otcMHac9zG4oU1KMHSTBpJuGQ2" -} -|json} with - | Error err -> raise (Failure err) - | Ok json -> - Data_encoding.Binary.to_bytes_exn Data_encoding.json json - -let protocol_parameters = - let json_result = - Data_encoding.Json.from_string {json| -{ "bootstrap_accounts": [ - [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav", "4000000000000" ], - [ "edpktzNbDAUjUk697W7gYg2CRuBQjyPxbEg8dLccYYwKSKvkPvjtV9", "4000000000000" ], - [ "edpkuTXkJDGcFd5nh6VvMz8phXxU3Bi7h6hqgywNFi1vZTfQNnS1RV", "4000000000000" ], - [ "edpkuFrRoDSEbJYgxRtLx2ps82UdaYc1WwfS9sE11yhauZt5DgCHbU", "4000000000000" ], - [ "edpkv8EUUH68jmo3f7Um5PezmfGrRF24gnfLpH3sVNwJnV5bVCxL2n", "4000000000000" ] - ], - "commitments": [ - [ "btz1bRL4X5BWo2Fj4EsBdUwexXqgTf75uf1qa", "23932454669343" ], - [ "btz1SxjV1syBgftgKy721czKi3arVkVwYUFSv", "72954577464032" ], - [ "btz1LtoNCjiW23txBTenALaf5H6NKF1L3c1gw", "217487035428348" ], - [ "btz1SUd3mMhEBcWudrn8u361MVAec4WYCcFoy", "4092742372031" ], - [ "btz1MvBXf4orko1tsGmzkjLbpYSgnwUjEe81r", "17590039016550" ], - [ "btz1LoDZ3zsjgG3k3cqTpUMc9bsXbchu9qMXT", "26322312350555" ], - [ "btz1RMfq456hFV5AeDiZcQuZhoMv2dMpb9hpP", "244951387881443" ], - [ "btz1Y9roTh4A7PsMBkp8AgdVFrqUDNaBE59y1", "80065050465525" ], - [ "btz1Q1N2ePwhVw5ED3aaRVek6EBzYs1GDkSVD", "3569618927693" ], - [ "btz1VFFVsVMYHd5WfaDTAt92BeQYGK8Ri4eLy", "9034781424478" ] - ], - "time_between_blocks" : [ 1, 0 ], - "blocks_per_cycle" : 4, - "blocks_per_roll_snapshot" : 2, - "first_free_baking_slot" : 4 -} -|json} in - match json_result with - | Error err -> raise (Failure err) - | Ok json -> - Data_encoding.Binary.to_bytes_exn Data_encoding.json json - - -let main () = - let context = Tezos_protocol_environment_memory.Context.empty in - Tezos_protocol_environment_memory.Context.set context - ["sandbox_parameter"] sandbox_parameters >>= fun context -> - Tezos_protocol_environment_memory.Context.set context - ["protocol_parameters"] protocol_parameters >>= fun context -> - let genesis_hash = - Block_hash.of_b58check_exn - "BLockGenesisGenesisGenesisGenesisGenesisCCCCCeZiLHU" in - let header = { - Block_header.level = 1l ; - proto_level = 0 ; - predecessor = genesis_hash ; - timestamp = Time.of_notation_exn "2017-09-22T00:00:00Z" ; - validation_passes = List.length Proto_alpha.Main.validation_passes ; - operations_hash = Helpers_misc.no_ops_hash ; - fitness = [] ; (* don't care *) - context = Context_hash.zero ; (* don't care *) - } in - let protocol_data = - Data_encoding.Binary.to_bytes_exn - Alpha_context.Block_header.contents_encoding - (Helpers_block.get_protocol_data 0 true) in - let tezos_header = { Block_header.shell = header ; protocol_data } in - Proto_alpha.init context header >>=? fun validation -> - let hash = Block_header.hash tezos_header in - Alpha_context.prepare - ~level: (Int32.succ header.level) - ~timestamp: header.timestamp - ~fitness: header.fitness - validation.context >>=? fun tezos_context -> - return - { Helpers_block.tezos_header ; hash ; level = tezos_header.shell.level ; - validation ; tezos_context } diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_logger.ml b/src/proto_alpha/lib_protocol/test/helpers/helpers_logger.ml deleted file mode 100644 index 1cdb1fd79..000000000 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_logger.ml +++ /dev/null @@ -1,11 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions , Inc.< contact@tezos.com > *) -(* *) -(* All rights reserved.No warranty , explicit or implicit , provided. *) -(* *) -(**************************************************************************) - -let name = "Isolate Helpers" -include Logging.Make(struct let name = name end) diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_logger.mli b/src/proto_alpha/lib_protocol/test/helpers/helpers_logger.mli deleted file mode 100644 index 29dd9cb7f..000000000 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_logger.mli +++ /dev/null @@ -1,12 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions , Inc.< contact@tezos.com > *) -(* *) -(* All rights reserved.No warranty , explicit or implicit , provided. *) -(* *) -(**************************************************************************) - -val name : string -include Logging.LOG - diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_misc.ml b/src/proto_alpha/lib_protocol/test/helpers/helpers_misc.ml deleted file mode 100644 index 61406e473..000000000 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_misc.ml +++ /dev/null @@ -1,35 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -exception Unknown_protocol - -let no_ops_hash = - Operation_list_list_hash.compute - (List.map (fun _ -> Operation_list_hash.empty) - Proto_alpha.Main.validation_passes) - -let find_account accounts hpub = - let hpub_pred (x : Helpers_account.t) = - Signature.Public_key_hash.equal x.hpub hpub in - List.find hpub_pred accounts - -let read_file path = - let (//) = Filename.concat in - let executable_path = Sys.getcwd () in - let path = - if Filename.is_relative path - then executable_path // path - else path - in - let ic = open_in path in - let n = in_channel_length ic in - let s = Bytes.create n in - really_input ic s 0 n ; - close_in ic ; - (Bytes.to_string s) diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_operation.ml b/src/proto_alpha/lib_protocol/test/helpers/helpers_operation.ml deleted file mode 100644 index 8aa8c37a8..000000000 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_operation.ml +++ /dev/null @@ -1,146 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -open Proto_alpha -open Error_monad -open Alpha_context - -let sourced ops = Sourced_operation ops - -let manager (src : Helpers_account.t) ?(fee = Tez.zero) operations context gas_limit = - Alpha_context.prepare - ~level:0l ~timestamp:(Time.now ()) ~fitness:[] context >>=? fun context -> - Contract.get_counter context src.contract >>=? fun counter -> - Contract.is_manager_key_revealed context src.contract >>=? fun revealed -> - let counter = Int32.succ counter in - return @@ - Manager_operations { - source = src.contract ; - fee ; - counter ; - operations = (if revealed then operations else Reveal src.pub :: operations) ; - gas_limit ; - storage_limit = 30_000L ; - } - - -let manager_full src ?(fee = Tez.zero) ops context gas_limit = - manager src ~fee ops context gas_limit >>=? fun ops -> return @@ sourced ops - - -let transaction ?parameters amount destination = - let parameters = Option.map ~f:Script.lazy_expr parameters in - Transaction { - amount ; - parameters ; - destination ; - } - - -let origination - ?(delegatable = true) ?(script = None) - ?(spendable = true) ?(delegate = None) - (manager: Helpers_account.t) credit - = - Origination { - manager = manager.hpub ; - delegate ; - spendable ; - delegatable ; - script ; - credit ; - preorigination = None ; - } - - -let delegation delegate = - Delegation (Some delegate) - - -let delegation_full ?(fee = Tez.zero) src delegate context = - manager_full src ~fee [delegation delegate] context Z.zero - - -let script_origination_full script src credit gas_limit context = - manager_full src ~fee: Tez.zero [origination ~script src credit] context gas_limit - - -let origination_full ?(spendable = true) ?(delegatable = true) ?(fee = Tez.zero) src credit gas_limit context = - manager_full src ~fee [origination ~spendable ~delegatable src credit] context gas_limit - - -let transaction_full ?(fee = Tez.zero) ?parameters src dst amount gas_limit context = - manager src ~fee [transaction ?parameters amount dst] context gas_limit - >>=? fun manager_op -> - return @@ sourced manager_op - - -let amendment_operation (src: Helpers_account.t) operation = - Amendment_operation { - source = src.hpub ; - operation - } - -let endorsements ?(slot = 0) block level = - Endorsements { - block ; - level ; - slots = [slot] ; - } - - -let endorsement_full ?(slot = 0) block level = - sourced - @@ Consensus_operation (endorsements block level ~slot) - -let sign src oph protop = - let watermark = - match protop with - | Proto_alpha.Alpha_context.Anonymous_operations _ -> None - | Proto_alpha.Alpha_context.Sourced_operation - (Proto_alpha.Alpha_context.Consensus_operation (Endorsements _)) -> - Some Signature.Endorsement - | _ -> - Some Generic_operation in - let signature = - match src with - | None -> None - | Some src -> - let contents = - Data_encoding.Binary.to_bytes_exn - Operation.unsigned_encoding (oph, protop) in - Some (Signature.sign ?watermark src.Helpers_account.ppk contents) in - let proto_bytes = - Data_encoding.Binary.to_bytes_exn - Operation.protocol_data_encoding - { contents = protop ; signature } in - (proto_bytes, signature) - -let main_of_proto (src: Helpers_account.t) operation_header protocol_operation = - let (proto,_) = sign (Some src) operation_header protocol_operation in - let data_operation: Tezos_base.Operation.t = - {shell = operation_header ; proto} in - let hash = Tezos_base.Operation.hash data_operation in - match Data_encoding.Binary.of_bytes - Operation.protocol_data_encoding proto with - | None -> - Error [] - | Some op -> - ok ({ shell = operation_header ; protocol_data = op }, hash) - -let apply_of_proto - (source: Helpers_account.t option) operation_header protocol_operation = - let (_proto, signature) = sign source operation_header protocol_operation in - { - shell = operation_header ; - protocol_data = { - contents = protocol_operation ; - signature - } - } diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_operation.mli b/src/proto_alpha/lib_protocol/test/helpers/helpers_operation.mli deleted file mode 100644 index 5848997e9..000000000 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_operation.mli +++ /dev/null @@ -1,71 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -open Proto_alpha -open Alpha_context - -(** Functions building operations *) - -val sourced : sourced_operation -> Operation.contents - -val manager : - Helpers_account.t -> ?fee:Tez.tez -> manager_operation list -> - Alpha_environment.Context.t -> Z.t -> sourced_operation proto_tzresult Lwt.t - -val manager_full : - Helpers_account.t -> ?fee:Tez.tez -> manager_operation list -> - Alpha_environment.Context.t -> Z.t -> Operation.contents proto_tzresult Lwt.t - -val transaction : - ?parameters:Script.expr -> Tez.t -> Contract.contract -> - manager_operation - -val origination : - ?delegatable:bool -> ?script:Script.t option -> ?spendable:bool -> - ?delegate:public_key_hash option -> Helpers_account.t -> Tez.t -> manager_operation - -val delegation : public_key_hash -> manager_operation - -val delegation_full : - ?fee:Tez.tez -> Helpers_account.t -> public_key_hash -> Alpha_environment.Context.t -> - Operation.contents proto_tzresult Lwt.t - -val script_origination_full : - Script.t option -> Helpers_account.t -> Tez.t -> Z.t -> Alpha_environment.Context.t -> - Operation.contents proto_tzresult Lwt.t - -val origination_full : - ?spendable:bool -> ?delegatable:bool -> ?fee:Tez.tez -> - Helpers_account.t -> Tez.t -> Z.t -> Alpha_environment.Context.t -> - Operation.contents proto_tzresult Lwt.t - -val transaction_full : - ?fee:Tez.tez -> ?parameters:Proto_alpha.Alpha_context.Script.expr -> Helpers_account.t -> Contract.contract -> Tez.t -> Z.t -> - Alpha_environment.Context.t -> Operation.contents proto_tzresult Lwt.t - -val amendment_operation : - Helpers_account.t -> amendment_operation -> sourced_operation - -val endorsements : - ?slot:int -> Block_hash.t -> Raw_level.t -> consensus_operation - -val endorsement_full : - ?slot:int -> Block_hash.t -> Raw_level.t -> Operation.contents - -val sign : - Helpers_account.t option -> Tezos_base.Operation.shell_header -> - Operation.contents -> MBytes.t * Signature.t option - -val main_of_proto : - Helpers_account.t -> Tezos_base.Operation.shell_header -> - Operation.contents -> (Main.operation * Operation_hash.t) proto_tzresult - -val apply_of_proto : - Helpers_account.t option -> Tezos_base.Operation.shell_header -> - Operation.contents -> operation diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_script.ml b/src/proto_alpha/lib_protocol/test/helpers/helpers_script.ml deleted file mode 100644 index 86d6d237b..000000000 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_script.ml +++ /dev/null @@ -1,43 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -open Proto_alpha -open Error_monad -open Alpha_context - -let init_amount = 20000 - -let execute_code_pred - ?tc (pred : Helpers_block.result) (script : Script.t) (parameter : Script.expr) = - let op = List.nth Helpers_account.bootstrap_accounts 0 in - let tc = Option.unopt ~default:pred.tezos_context tc in - Helpers_apply.script_origination_pred ~tc ~pred (script, op, init_amount) - >>=? fun (dst, tc) -> - let dst = List.hd dst in - let ctxt = Helpers_cast.ctxt_of_tc tc in - let gas = Proto_alpha.Alpha_context.Constants.hard_gas_limit_per_operation tc in - Helpers_operation.transaction_full op dst Tez.zero gas ctxt - >>=? fun dummy_protop -> - let op_header = Helpers_block.get_op_header_res pred in - let apply_op = Helpers_operation.apply_of_proto - (Some op) op_header dummy_protop in - let hash = Operation.hash apply_op in - let amount = Tez.zero in - Lwt.return (Proto_alpha.Alpha_context.Gas.set_limit tc gas) >>=? fun tc -> - let tc = Contract.init_origination_nonce tc hash in - Script_interpreter.execute - tc Readable - ~source: op.contract - ~payer: op.contract - ~self: (dst, script) - ~amount ~parameter >>=? fun ({ ctxt ; storage ; big_map_diff } as res) -> - Proto_alpha.Alpha_context.Contract.update_script_storage ctxt dst storage big_map_diff >>=? fun ctxt -> - return (dst, { res with ctxt }) - - diff --git a/src/proto_alpha/lib_protocol/test/helpers/incremental.ml b/src/proto_alpha/lib_protocol/test/helpers/incremental.ml new file mode 100644 index 000000000..334b0d6bb --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/helpers/incremental.ml @@ -0,0 +1,114 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Proto_alpha +open Alpha_context + +type t = { + predecessor: Block.t ; + state: M.validation_state ; + rev_operations: Operation.t list ; + header: Block_header.t ; + delegate: Account.t ; +} +type incremental = t + +let predecessor { predecessor ; _ } = predecessor + +let level st = st.header.shell.level + +let rpc_context st = + let operations = lazy (List.rev st.rev_operations) in + let operations_hashes = + lazy (List.map Operation.hash (Lazy.force operations)) in + let result = Alpha_context.finalize st.state.ctxt in + Lwt.return { + Alpha_environment.Updater.block_hash = Block_hash.zero ; + block_header = + Block_header.raw + { st.header with + shell = { st.header.shell with fitness = result.fitness }} ; + operation_hashes = (fun () -> Lwt.return [Lazy.force operations_hashes]) ; + operations = (fun () -> + Lwt.return [List.map Operation.raw (Lazy.force operations)]) ; + context = result.context ; + } + +let rpc_ctxt = + new Alpha_environment.proto_rpc_context_of_directory + rpc_context Proto_alpha.rpc_services + +let begin_construction ?(priority=0) ?timestamp (predecessor : Block.t) = + Block.get_next_baker ~policy:(Block.By_priority priority) + predecessor >>=? fun (delegate, priority, real_timestamp) -> + Account.find delegate >>=? fun delegate -> + let timestamp = Option.unopt ~default:real_timestamp timestamp in + let contents = Block.Forge.contents ~priority () in + let protocol_data = { + Block_header.contents ; + signature = Signature.zero ; + } in + let header = { + Block_header.shell = { + predecessor = predecessor.hash ; + proto_level = predecessor.header.shell.proto_level ; + validation_passes = predecessor.header.shell.validation_passes ; + fitness = predecessor.header.shell.fitness ; + timestamp ; + (* TODO : CHECK THAT OUT -- incoherent level *) + level = predecessor.header.shell.level ; + context = Context_hash.zero ; + operations_hash = Operation_list_list_hash.zero ; + } ; + protocol_data = { + contents ; + signature = Signature.zero ; + } ; + } in + M.begin_construction + ~predecessor_context: predecessor.context + ~predecessor_timestamp: predecessor.header.shell.timestamp + ~predecessor_fitness: predecessor.header.shell.fitness + ~predecessor_level: predecessor.header.shell.level + ~predecessor:predecessor.hash + ~timestamp + ~protocol_data + () >>=? fun state -> + return { + predecessor ; + state ; + rev_operations = [] ; + header ; + delegate ; + } + +let add_operation st op = + M.apply_operation st.state op >>=? fun (state, _result) -> + return { st with state ; rev_operations = op :: st.rev_operations } + +let finalize_block st = + M.finalize_block st.state >>=? fun (result, _) -> + let operations = List.rev st.rev_operations in + let operations_hash = + Operation_list_list_hash.compute [ + Operation_list_hash.compute (List.map Operation.hash operations) + ] in + let header = + { st.header with + shell = { + st.header.shell with + operations_hash ; fitness = result.fitness ; + } } in + let hash = Block_header.hash header in + return { + Block.hash ; + header ; + operations ; + context = result.context ; + } diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_services.ml b/src/proto_alpha/lib_protocol/test/helpers/incremental.mli similarity index 55% rename from src/proto_alpha/lib_protocol/test/helpers/helpers_services.ml rename to src/proto_alpha/lib_protocol/test/helpers/incremental.mli index 9602568ad..7677d4404 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_services.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/incremental.mli @@ -1,6 +1,6 @@ (**************************************************************************) (* *) -(* Copyright (c) 2014 - 2016. *) +(* Copyright (c) 2014 - 2018. *) (* Dynamic Ledger Solutions, Inc. *) (* *) (* All rights reserved. No warranty, explicit or implicit, provided. *) @@ -9,15 +9,22 @@ open Proto_alpha open Alpha_context -open Helpers_assert -let endorsement_rights ~tc () = - let level = Level.current tc in - Alpha_services.Delegate.endorsement_rights tc level None >>=?? fun (_, endorsers) -> - return @@ List.mapi (fun x i -> x, i) endorsers +type t +type incremental = t +val predecessor: incremental -> Block.t -let baking_rights ~tc () = - Alpha_services.Delegate.baking_rights tc () None >>=?? fun (_, bakers) -> - return @@ List.mapi (fun x (i,_) -> x, i) bakers +val level: incremental -> int32 +val begin_construction: + ?priority:int -> + ?timestamp:Time.t -> + Block.t -> incremental tzresult Lwt.t + +val add_operation: + incremental -> Operation.t -> incremental tzresult Lwt.t + +val finalize_block: incremental -> Block.t tzresult Lwt.t + +val rpc_ctxt: incremental Alpha_environment.RPC_context.simple diff --git a/src/proto_alpha/lib_protocol/test/helpers/isolate_helpers.ml b/src/proto_alpha/lib_protocol/test/helpers/isolate_helpers.ml deleted file mode 100644 index fa2e20b7f..000000000 --- a/src/proto_alpha/lib_protocol/test/helpers/isolate_helpers.ml +++ /dev/null @@ -1,53 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -open Proto_alpha - -module Crypto = Helpers_crypto -module Cast = Helpers_cast -module Assert = Helpers_assert -module Services = Helpers_services -module Account = Helpers_account -module Misc = Helpers_misc -module Operation = Helpers_operation -module Block = Helpers_block -module Init = Helpers_init -module Apply = Helpers_apply -module Script = Helpers_script - -module Shorthands = struct - - let to_tc_full ctxt level fitness = - Alpha_context.prepare - ctxt - ~level - ~fitness - ~timestamp:(Time.now()) - - let get_tc_full (res:Block.result) = - Alpha_context.prepare - res.validation.context - ~level:res.level - ~timestamp:res.tezos_header.shell.timestamp - ~fitness:res.validation.fitness - - let get_balance_res (account:Account.t) (result:Block.result) = - let open Alpha_environment.Error_monad in - get_tc_full result >>=? fun tc -> - Alpha_context.Contract.get_balance tc account.contract - - let chain_empty_block (result:Block.result) = - Block.empty - result.tezos_header.shell - result.hash - result.level - 15 - result.validation.context - -end diff --git a/src/proto_alpha/lib_protocol/test/helpers/jbuild b/src/proto_alpha/lib_protocol/test/helpers/jbuild index b76f0759c..4e2906700 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/jbuild +++ b/src/proto_alpha/lib_protocol/test/helpers/jbuild @@ -1,18 +1,17 @@ (jbuild_version 1) (library - ((name tezos_proto_alpha_isolate_helpers) + ((name tezos_alpha_test_helpers) (libraries (tezos-base tezos-stdlib-unix tezos-protocol-environment tezos-protocol-alpha alcotest-lwt)) - (wrapped false) (flags (:standard -w -9-32 -safe-string -open Tezos_base__TzPervasives -open Tezos_stdlib_unix)))) (alias ((name runtest_indent) - (deps ((glob_files *.ml{,i}))) + (deps ((glob_files *.ml*))) (action (run bash ${libexec:tezos-stdlib:test-ocp-indent.sh} ${^})))) diff --git a/src/proto_alpha/lib_protocol/test/helpers/nonce.ml b/src/proto_alpha/lib_protocol/test/helpers/nonce.ml new file mode 100644 index 000000000..416cec574 --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/helpers/nonce.ml @@ -0,0 +1,33 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc.< contact@tezos.com > *) +(* *) +(* All rights reserved.No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Proto_alpha + +module Table = Hashtbl.Make(struct + type t = Nonce_hash.t + let hash h = + Int32.to_int (MBytes.get_int32 (Nonce_hash.to_bytes h) 0) + let equal = Nonce_hash.equal + end) + +let known_nonces = Table.create 17 + +let generate () = + match + Alpha_context.Nonce.of_bytes @@ + Rand.generate Alpha_context.Constants.nonce_length + with + | Ok nonce -> + let hash = Alpha_context.Nonce.hash nonce in + Table.add known_nonces hash nonce ; + (hash, nonce) + | Error _ -> assert false + +let forget_all () = Table.clear known_nonces +let get hash = Table.find known_nonces hash diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_init.mli b/src/proto_alpha/lib_protocol/test/helpers/nonce.mli similarity index 75% rename from src/proto_alpha/lib_protocol/test/helpers/helpers_init.mli rename to src/proto_alpha/lib_protocol/test/helpers/nonce.mli index 1d4943278..e6ce79a0b 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_init.mli +++ b/src/proto_alpha/lib_protocol/test/helpers/nonce.mli @@ -9,6 +9,7 @@ open Proto_alpha -(** Functions used to build the first tezos_context and first block *) - -val main : unit -> Helpers_block.result proto_tzresult Lwt.t +(** Returns a fresh nonce and its corresponding hash (and stores them). *) +val generate: unit -> Nonce_hash.t * Alpha_context.Nonce.t +val get: Nonce_hash.t -> Alpha_context.Nonce.t +val forget_all: unit -> unit diff --git a/src/proto_alpha/lib_protocol/test/helpers/op.ml b/src/proto_alpha/lib_protocol/test/helpers/op.ml new file mode 100644 index 000000000..9219eb1cb --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/helpers/op.ml @@ -0,0 +1,178 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Proto_alpha +open Alpha_context + +let sign ?(watermark = Signature.Generic_operation) sk ctxt contents = + let branch = Context.branch ctxt in + let unsigned = + Data_encoding.Binary.to_bytes_exn + Operation.unsigned_encoding + ({ branch }, contents) in + let signature = Some (Signature.sign ~watermark sk unsigned) in + { shell = { branch } ; + protocol_data = { + contents ; + signature ; + } ; + } + +let endorsement ?delegate ?level ctxt = + fun ?(signing_context=ctxt) slot -> + begin + match delegate with + | None -> Context.get_endorser ctxt slot + | Some delegate -> return delegate + end >>=? fun delegate_pkh -> + Account.find delegate_pkh >>=? fun delegate -> + begin + match level with + | None -> Context.get_level ctxt + | Some level -> return level + end >>=? fun level -> + let op = + let operations = Endorsements { block = Context.branch ctxt ; level ; slots = [slot] } in + Sourced_operation (Consensus_operation operations) in + return (sign ~watermark:Signature.Endorsement delegate.sk signing_context op) + +let manager_operations ?(fee = Tez.zero) + ?(gas_limit = Constants_repr.default.hard_gas_limit_per_operation) + ?(storage_limit = Constants_repr.default.hard_storage_limit_per_operation) + ?public_key ~source ctxt operations = + Context.Contract.counter ctxt source >>=? fun counter -> + Context.Contract.manager ctxt source >>=? fun account -> + let public_key = Option.unopt ~default:account.pk public_key in + let counter = Int32.succ counter in + Context.Contract.is_manager_key_revealed ctxt source >>=? begin function + | true -> return operations + | false -> return @@ (Reveal public_key) :: operations end >>=? fun operations -> + return @@ Manager_operations { + source ; + fee ; + counter ; + operations ; + gas_limit ; + storage_limit ; + } + +let revelation ctxt public_key = + let pkh = Signature.Public_key.hash public_key in + let contract = Contract.implicit_contract pkh in + manager_operations ~source:contract ~public_key ctxt [] >>=? fun mop -> + let sop = Sourced_operation mop in + Context.Contract.manager ctxt contract >>=? fun account -> + return @@ sign account.sk ctxt sop + +let originated_contract (op:Operation.t) = + let nonce = Contract.initial_origination_nonce (Operation.hash op) in + Contract.originated_contract nonce + +exception Impossible + +let origination ?delegate ?script + ?(spendable = true) ?(delegatable = true) ?(preorigination = None) + ?public_key ?manager ?credit ?fee ?gas_limit ?storage_limit ctxt source = + Context.Contract.manager ctxt source >>=? fun account -> + let manager = Option.unopt ~default:account.pkh manager in + let default_credit = Tez.of_mutez @@ Int64.of_int 1000001 in + let default_credit = Option.unopt_exn Impossible default_credit in + let credit = Option.unopt ~default:default_credit credit in + let operations = [Origination { + manager ; + delegate ; + script ; + spendable ; + delegatable ; + credit ; + preorigination ; + }] in + manager_operations ?public_key ?fee ?gas_limit ?storage_limit + ~source ctxt operations >>=? fun mop -> + let sop = Sourced_operation mop in + let op:Operation.t = sign account.sk ctxt sop in + return (op , originated_contract op) + +let miss_signed_endorsement ?level ctxt slot = + begin + match level with + | None -> Context.get_level ctxt + | Some level -> return level + end >>=? fun level -> + Context.get_endorser ctxt slot >>=? fun real_delegate_pkh -> + let delegate = Account.find_alternate real_delegate_pkh in + endorsement ~delegate:delegate.pkh ~level ctxt slot + +let transaction ?fee ?gas_limit ?storage_limit ?parameters ctxt + (src:Contract.t) (dst:Contract.t) + (amount:Tez.t) = + let top = Transaction { + amount; + parameters; + destination=dst; + } in + manager_operations ?fee ?gas_limit ?storage_limit + ~source:src ctxt [top] >>=? fun mop -> + let sop = Sourced_operation mop in + Context.Contract.manager ctxt src >>=? fun account -> + return @@ sign account.sk ctxt sop + +let delegation ?fee ctxt source dst = + let top = Delegation dst in + manager_operations ?fee ~source ctxt [top] >>=? fun mop -> + let sop = Sourced_operation mop in + Context.Contract.manager ctxt source >>=? fun account -> + return @@ sign account.sk ctxt sop + +let activation ctxt (pkh : Signature.Public_key_hash.t) activation_code = + begin match pkh with + | Ed25519 edpkh -> return edpkh + | _ -> failwith "Wrong public key hash : %a - Commitments must be activated with an Ed25519 \ + encrypted public key hash" Signature.Public_key_hash.pp pkh + end >>=? fun id -> + let contents = + Anonymous_operations + [ Activation { id ; activation_code } ] + in + let branch = Context.branch ctxt in + return { + shell = { branch } ; + protocol_data = { + contents ; + signature = None ; + } ; + } + +let double_endorsement ctxt op1 op2 = + let contents = + Anonymous_operations [ + Double_endorsement_evidence {op1 ; op2} + ] in + let branch = Context.branch ctxt in + return { + shell = { branch } ; + protocol_data = { + contents ; + signature = None ; + } ; + } + +let double_baking ctxt bh1 bh2 = + let contents = + Anonymous_operations [ + Double_baking_evidence {bh1 ; bh2} + ] in + let branch = Context.branch ctxt in + return { + shell = { branch } ; + protocol_data = { + contents ; + signature = None ; + } ; + } diff --git a/src/proto_alpha/lib_protocol/test/helpers/op.mli b/src/proto_alpha/lib_protocol/test/helpers/op.mli new file mode 100644 index 000000000..a16450556 --- /dev/null +++ b/src/proto_alpha/lib_protocol/test/helpers/op.mli @@ -0,0 +1,72 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Proto_alpha +open Alpha_context + +val endorsement: + ?delegate:public_key_hash -> + ?level:Raw_level.t -> + Context.t -> ?signing_context:Context.t -> + int -> Operation.t tzresult Lwt.t + +val miss_signed_endorsement: + ?level:Raw_level.t -> + Context.t -> int -> Operation.t tzresult Lwt.t + +val transaction: + ?fee:Tez.tez -> + ?gas_limit:Z.t -> + ?storage_limit:int64 -> + ?parameters:Script.lazy_expr -> + Context.t -> + Contract.t -> + Contract.t -> + Tez.t -> + Operation.t tzresult Lwt.t + +val delegation: + ?fee:Tez.tez -> Context.t -> + Contract.t -> public_key_hash option -> + Operation.t tzresult Lwt.t + +val revelation: + Context.t -> public_key -> Operation.t tzresult Lwt.t + +val origination: + ?delegate:public_key_hash -> + ?script:Script.t -> + ?spendable:bool -> + ?delegatable:bool -> + ?preorigination: Contract.contract option -> + ?public_key:public_key -> + ?manager:public_key_hash -> + ?credit:Tez.tez -> + ?fee:Tez.tez -> + ?gas_limit:Z.t -> + ?storage_limit:int64 -> + Context.t -> + Contract.contract -> + (Operation.t * Contract.contract) tzresult Lwt.t + +val originated_contract: + Operation.t -> Contract.contract + +val double_endorsement: + Context.t -> Operation.t -> Operation.t + -> Operation.t tzresult Lwt.t + +val double_baking: + Context.t -> Block_header.block_header -> Block_header.block_header + -> Operation.t tzresult Lwt.t + +val activation: + Context.t -> + Signature.Public_key_hash.t -> Blinded_public_key_hash.activation_code -> + Operation.t tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/test/helpers/proto_alpha.ml b/src/proto_alpha/lib_protocol/test/helpers/proto_alpha.ml index 6cf2d00f6..8667d8d37 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/proto_alpha.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/proto_alpha.ml @@ -8,11 +8,11 @@ (**************************************************************************) module Name = struct let name = "alpha" end -module Context = Tezos_protocol_environment_memory.Context module Alpha_environment = Tezos_protocol_environment_memory.MakeV1(Name)() + +type alpha_error = Alpha_environment.Error_monad.error +type 'a alpha_tzresult = 'a Alpha_environment.Error_monad.tzresult + include Tezos_protocol_alpha.Functor.Make(Alpha_environment) -module Error_monad = Alpha_environment.Error_monad -type proto_error = Error_monad.error -type 'a proto_tzresult = 'a Error_monad.tzresult - +module M = Alpha_environment.Lift(Main) diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_misc.mli b/src/proto_alpha/lib_protocol/test/helpers/test.ml similarity index 61% rename from src/proto_alpha/lib_protocol/test/helpers/helpers_misc.mli rename to src/proto_alpha/lib_protocol/test/helpers/test.ml index 3eba06c7c..cd51cb1e4 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_misc.mli +++ b/src/proto_alpha/lib_protocol/test/helpers/test.ml @@ -7,13 +7,13 @@ (* *) (**************************************************************************) -exception Unknown_protocol - -(** Miscellaneous self-descriptive functions *) - -val no_ops_hash : Operation_list_list_hash.t - -val find_account : - Helpers_account.t list -> Signature.Public_key_hash.t -> Helpers_account.t - -val read_file : string -> string +(* Wraps an alcotest so that it prints correcly errors from the Error_monad. *) +let tztest name speed f = + Alcotest_lwt.test_case name speed begin fun _sw () -> + f () >>= function + | Ok () -> Lwt.return_unit + | Error err -> + Tezos_stdlib_unix.Logging_unix.close () >>= fun () -> + Format.eprintf "WWW %a@." pp_print_error err ; + Lwt.fail Alcotest.Test_error + end diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_script.mli b/src/proto_alpha/lib_protocol/test/helpers/test_tez.ml similarity index 53% rename from src/proto_alpha/lib_protocol/test/helpers/helpers_script.mli rename to src/proto_alpha/lib_protocol/test/helpers/test_tez.ml index 4439e74aa..d133476a9 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_script.mli +++ b/src/proto_alpha/lib_protocol/test/helpers/test_tez.ml @@ -1,6 +1,6 @@ (**************************************************************************) (* *) -(* Copyright (c) 2014 - 2016. *) +(* Copyright (c) 2014 - 2018. *) (* Dynamic Ledger Solutions, Inc. *) (* *) (* All rights reserved. No warranty, explicit or implicit, provided. *) @@ -9,9 +9,19 @@ open Proto_alpha open Alpha_context +open Alpha_environment -val init_amount : int -val execute_code_pred : - ?tc:Alpha_context.t -> Helpers_block.result -> Script.t -> Script.expr -> - (Alpha_context.Contract.t * Script_interpreter.execution_result) proto_tzresult Lwt.t +(* This module is mostly to wrap the errors from the protocol *) +module Tez = struct + include Tez + let ( +? ) t1 t2 = (t1 +? t2) |> wrap_error + let ( -? ) t1 t2 = (t1 -? t2) |> wrap_error + let ( *? ) t1 t2 = (t1 *? t2) |> wrap_error + let ( /? ) t1 t2 = (t1 /? t2) |> wrap_error + + let of_int x = + match Tez.of_mutez (Int64.mul (Int64.of_int x) 1_000_000L) with + | None -> invalid_arg "tez_of_int" + | Some x -> x +end diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_services.mli b/src/proto_alpha/lib_protocol/test/helpers/test_utils.ml similarity index 52% rename from src/proto_alpha/lib_protocol/test/helpers/helpers_services.mli rename to src/proto_alpha/lib_protocol/test/helpers/test_utils.ml index f99374e54..81ed24496 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_services.mli +++ b/src/proto_alpha/lib_protocol/test/helpers/test_utils.ml @@ -1,20 +1,27 @@ (**************************************************************************) (* *) -(* Copyright (c) 2014 - 2016. *) +(* Copyright (c) 2014 - 2018. *) (* Dynamic Ledger Solutions, Inc. *) (* *) (* All rights reserved. No warranty, explicit or implicit, provided. *) (* *) (**************************************************************************) -open Proto_alpha +(* This file should not depend on any other file from tests. *) -(** Wrappers around Services_registration calls *) +let (>>?=) x y = match x with + | Ok(a) -> y a + | Error(b) -> fail @@ List.hd b -val endorsement_rights : - tc:Alpha_context.context -> unit -> - (int * Alpha_context.public_key_hash) list tzresult Lwt.t +(** Like List.find but returns the index of the found element *) +let findi p = + let rec aux p i = function + | [] -> raise Not_found + | x :: l -> if p x then (x,i) else aux p (i+1) l + in + aux p 0 -val baking_rights : - tc:Alpha_context.context -> unit -> - (int * Alpha_context.public_key_hash) list tzresult Lwt.t +exception Pair_of_list +let pair_of_list = function + | [a;b] -> a,b + | _ -> raise Pair_of_list diff --git a/src/proto_alpha/lib_protocol/test/jbuild b/src/proto_alpha/lib_protocol/test/jbuild index 0d998881e..105ad647c 100644 --- a/src/proto_alpha/lib_protocol/test/jbuild +++ b/src/proto_alpha/lib_protocol/test/jbuild @@ -4,24 +4,35 @@ ((name main) (libraries (tezos-base tezos-micheline - tezos_proto_alpha_isolate_helpers - tezos_proto_alpha_isolate_michelson_parser - alcotest-lwt)) + tezos-protocol-environment + alcotest-lwt + tezos_alpha_test_helpers + michelson_parser + tezos-stdlib-unix + bip39 + )) (flags (:standard -w -9-32 -safe-string -open Tezos_base__TzPervasives -open Tezos_micheline - -open Tezos_proto_alpha_isolate_michelson_parser)))) + -open Tezos_alpha_test_helpers +)))) (alias ((name buildtest) (package tezos-protocol-alpha) (deps (main.exe)))) +; runs only the `Quick tests (alias ((name runtest_proto_alpha) (package tezos-protocol-alpha) - (deps (sandbox.json (glob_files contracts/*.tz))) - (action (chdir ${ROOT} (run ${exe:main.exe}))))) + (action (chdir ${ROOT} (run ${exe:main.exe} -v -q))))) + +; runs both `Quick and `Slow tests +(alias + ((name runtest_slow) + (package tezos-protocol-alpha) + (action (chdir ${ROOT} (run ${exe:main.exe} -v))))) (alias ((name runtest) @@ -30,5 +41,5 @@ (alias ((name runtest_indent) - (deps ((glob_files *.ml{,i}))) + (deps ((glob_files *.ml*))) (action (run bash ${libexec:tezos-stdlib:test-ocp-indent.sh} ${^})))) diff --git a/src/proto_alpha/lib_protocol/test/main.ml b/src/proto_alpha/lib_protocol/test/main.ml index b7588ec67..bac9f389e 100644 --- a/src/proto_alpha/lib_protocol/test/main.ml +++ b/src/proto_alpha/lib_protocol/test/main.ml @@ -7,24 +7,14 @@ (* *) (**************************************************************************) -let wrap (n, f) = - Alcotest_lwt.test_case n `Quick begin fun _ () -> - f () >>= function - | Ok () -> Lwt.return_unit - | Error error -> - Format.kasprintf Pervasives.failwith "%a" - (Format.pp_print_list - (fun ppf e -> Data_encoding.Json.pp ppf (Error_monad.json_of_error e))) - error - end - let () = - Alcotest.run "tezos-protocol-alpha" [ - "dsl", List.map wrap Test_dsl.tests ; - "transaction", List.map wrap Test_transaction.tests ; - "endorsement", List.map wrap Test_endorsement.tests ; - "origination", List.map wrap Test_origination.tests ; - "bigmaps", List.map wrap Test_big_maps.tests ; - "michelson", List.map wrap Test_michelson.tests ; - (* "activation", List.map wrap Test_activation.tests ; *) + Alcotest.run "protocol_alpha" [ + "transfer", Transfer.tests ; + "origination", Origination.tests ; + "baking", Baking.tests ; + "activation", Activation.tests ; + "seed", Seed.tests ; + "endorsement", Endorsement.tests ; + "double endorsement", Double_endorsement.tests ; + "double baking", Double_baking.tests ; ] diff --git a/src/proto_alpha/lib_protocol/test/michelson_parser/jbuild b/src/proto_alpha/lib_protocol/test/michelson_parser/jbuild index 19259d4a7..031677463 100644 --- a/src/proto_alpha/lib_protocol/test/michelson_parser/jbuild +++ b/src/proto_alpha/lib_protocol/test/michelson_parser/jbuild @@ -1,13 +1,15 @@ (jbuild_version 1) (library - ((name tezos_proto_alpha_isolate_michelson_parser) + ((name michelson_parser) (libraries (tezos-base - tezos_proto_alpha_isolate_helpers)) + tezos_alpha_test_helpers + )) (flags (:standard -w -9-32 -safe-string - -open Tezos_base__TzPervasives)))) + -open Tezos_base__TzPervasives + -open Tezos_alpha_test_helpers)))) (alias ((name runtest_indent) - (deps ((glob_files *.ml{,i}))) + (deps ((glob_files *.ml*))) (action (run bash ${libexec:tezos-stdlib:test-ocp-indent.sh} ${^})))) diff --git a/src/proto_alpha/lib_protocol/test/michelson_parser/michelson_v1_parser.ml b/src/proto_alpha/lib_protocol/test/michelson_parser/v1.ml similarity index 100% rename from src/proto_alpha/lib_protocol/test/michelson_parser/michelson_v1_parser.ml rename to src/proto_alpha/lib_protocol/test/michelson_parser/v1.ml diff --git a/src/proto_alpha/lib_protocol/test/michelson_parser/michelson_v1_parser.mli b/src/proto_alpha/lib_protocol/test/michelson_parser/v1.mli similarity index 100% rename from src/proto_alpha/lib_protocol/test/michelson_parser/michelson_v1_parser.mli rename to src/proto_alpha/lib_protocol/test/michelson_parser/v1.mli diff --git a/src/proto_alpha/lib_protocol/test/sandbox.json b/src/proto_alpha/lib_protocol/test/sandbox.json deleted file mode 100644 index e69de29bb..000000000 diff --git a/src/proto_alpha/lib_protocol/test/test_activation.ml b/src/proto_alpha/lib_protocol/test/test_activation.ml deleted file mode 100644 index 2642c8aa5..000000000 --- a/src/proto_alpha/lib_protocol/test/test_activation.ml +++ /dev/null @@ -1,82 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -open Proto_alpha -open Alpha_context -open Error_monad - -let name = "Isolate Activation" - -exception No_error - -open Isolate_helpers - -let pk = - Ed25519.Public_key.of_b58check_exn - "edpkuSR6ywqsk17myFVRcw2eXhVib2MeLc9D1QkEQb98ctWUBwSJpF" -let pkh = Ed25519.Public_key.hash pk -let half_pkh = - let len = Ed25519.Public_key_hash.size / 2 in - MBytes.sub (Ed25519.Public_key_hash.to_bytes pkh) 0 (len / 2) - -let given_secret = - Blinded_public_key_hash.secret_of_hex - "0f39ed0b656509c2ecec4771712d9cddefe2afac" - -let expected_blinded_pkh = - Blinded_public_key_hash.of_b58check_exn - "btz1bRL4X5BWo2Fj4EsBdUwexXqgTf75uf1qa" - -let expected_amount = - match Tez.of_mutez 23932454669343L with - | Some s -> s - | _ -> assert false - -let test_hash_correctness () = - - let blinded_pkh = - Blinded_public_key_hash.of_ed25519_pkh given_secret pkh in - - Assert.equal - ~msg: __LOC__ - ~eq: Blinded_public_key_hash.(=) - blinded_pkh expected_blinded_pkh ; - - return () - -let test_simple_activation () = - - Init.main () >>=? fun starting_block -> - - let activation_operation = - Alpha_context.Activation - { id = pkh ; secret = given_secret } in - - Proto_alpha.Apply.apply_anonymous_operation - starting_block.tezos_context - None - activation_operation >>=? fun ctxt -> - - let contract = Contract.implicit_contract pkh in - - Contract.get_balance ctxt contract >>=? fun amount -> - - Assert.equal - ~msg: __LOC__ - ~eq:Tez.equal - amount expected_amount ; - - return () - -let tests = - List.map - (fun (n, f) -> (n, (fun () -> f () >>= Assert.wrap))) - [ "activation.hash_correctness", test_hash_correctness ; - "activation.simple_activation", test_simple_activation - ] diff --git a/src/proto_alpha/lib_protocol/test/test_big_maps.ml b/src/proto_alpha/lib_protocol/test/test_big_maps.ml deleted file mode 100644 index 695e1a291..000000000 --- a/src/proto_alpha/lib_protocol/test/test_big_maps.ml +++ /dev/null @@ -1,125 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - - -let name = "bigmap" -module Logger = Logging.Make(struct let name = name end) - -open Logger - -module Helpers = Isolate_helpers -module Assert = Helpers.Assert - -let (>>??) = Helpers.Assert.(>>??) -let (>>=??) = Helpers.Assert.(>>=??) - -let parse_expr s : Proto_alpha.Alpha_context.Script.expr tzresult = - Micheline_parser.no_parsing_error (Michelson_v1_parser.parse_expression s) >>? fun parsed -> - ok parsed.expanded - -let parse_script code_str storage_str : Proto_alpha.Alpha_context.Script.t tzresult = - parse_expr code_str >>? fun code -> - let code = Proto_alpha.Alpha_context.Script.lazy_expr code in - parse_expr storage_str >>? fun storage -> - let storage = Proto_alpha.Alpha_context.Script.lazy_expr storage in - ok { Proto_alpha.Alpha_context.Script.code ; storage } - -let code = {| -{ parameter (list (pair string int)) ; - storage (pair (big_map string int) unit) ; - code { UNPAAIAIR ; - ITER { UNPAIR ; DUUUP ; DUUP; GET ; - IF_NONE { PUSH int 0 } {} ; - SWAP ; DIP { ADD ; SOME } ; - UPDATE } ; - PAIR ; NIL operation ; PAIR } } -|} - -let storage = {| Pair { Elt "A" 1 ; Elt "B" 2 } Unit |} - -let expect_big_map tc contract print_key key_type print_data data_type contents = - let open Proto_alpha.Error_monad in - iter_p - (fun (n, exp) -> - Proto_alpha.Script_ir_translator.hash_data tc key_type n >>=? fun (key, tc) -> - Proto_alpha.Alpha_context.Contract.Big_map.get_opt tc contract key >>=? fun (_tc, data) -> - match data, exp with - | None, None -> - debug " - big_map[%a] is not defined (ok)" print_key n ; - return () - | None, Some _ -> - debug " - big_map[%a] is not defined (error)" print_key n ; - Helpers_assert.fail_msg "Wrong big map contents" - | Some data, None -> - Proto_alpha.Script_ir_translator.parse_data tc - data_type (Micheline.root data) >>=? fun (data, _tc) -> - debug " - big_map[%a] = %a (error)" print_key n print_data data ; - Helpers_assert.fail_msg "Wrong big map contents" - | Some data, Some exp -> - Proto_alpha.Script_ir_translator.parse_data tc - data_type (Micheline.root data) >>=? fun (data, _tc) -> - debug " - big_map[%a] = %a (expected %a)" print_key n print_data data print_data exp ; - Helpers_assert.equal data exp ; - return ()) - contents - -let main () = - Helpers.Init.main () >>=?? fun pred -> - let tc = pred.Helpers.Block.tezos_context in - let src = List.hd Helpers.Account.bootstrap_accounts in - Lwt.return (parse_script code storage) >>=? fun script -> - Helpers.Apply.script_origination_pred - ~tc ~pred (script , src, 100_00) >>=?? fun (contracts, tc) -> - begin match contracts with - | [ contract ] -> return contract - | _ -> failwith "more than one contract" - end >>=? fun contract -> - debug "contract created" ; - let expect_big_map tc exp = - expect_big_map tc contract - (fun ppf k -> Format.fprintf ppf "%s" k) - Proto_alpha.Script_typed_ir.String_t - (fun ppf n -> Format.fprintf ppf "%s" (Proto_alpha.Alpha_context.Script_int.to_string n)) - Proto_alpha.Script_typed_ir.Int_t - (List.map (fun (n, v) -> (n, Option.map ~f:Proto_alpha.Alpha_context.Script_int.of_int v)) exp) in - expect_big_map tc - [ "A", Some 1 ; "B", Some 2 ; "C", None ; "D", None ] >>=?? fun () -> - debug "initial big map is ok" ; - let call tc input result = - Lwt.return (parse_expr input) >>=? fun parameters -> - let gas = Proto_alpha.Alpha_context.Constants.hard_gas_limit_per_operation tc in - Helpers.Operation.transaction_full - src contract (Helpers_cast.cents_of_int 100_00) - gas (Helpers_cast.ctxt_of_tc tc) - ~parameters >>=?? fun op -> - Helpers.Apply.operation ~tc - ~src pred.Helpers_block.hash - (Helpers_block.get_op_header_res pred) - op >>=?? fun (_, tc) -> - expect_big_map tc result >>=?? fun () -> - debug "big map after call %s is ok" input ; - return tc in - call tc - {| {} |} - [ "A", Some 1 ; "B", Some 2 ; "C", None ; "D", None ] >>=? fun tc -> - call tc - {| { Pair "A" 2 } |} - [ "A", Some 3 ; "B", Some 2 ; "C", None ; "D", None ] >>=? fun tc -> - call tc - {| { Pair "A" 2 ; Pair "A" 2 ; Pair "D" 8 } |} - [ "A", Some 7 ; "B", Some 2 ; "C", None ; "D", Some 8 ] >>=? fun tc -> - call tc - {| { Pair "C" 3 } |} - [ "A", Some 7 ; "B", Some 2 ; "C", Some 3 ; "D", Some 8 ] >>=? fun _tc -> - Error_monad.return () - - -let tests = [ - "bigmaps", (fun _ -> main ()) ; -] diff --git a/src/proto_alpha/lib_protocol/test/test_dsl.ml b/src/proto_alpha/lib_protocol/test/test_dsl.ml deleted file mode 100644 index 1474735dc..000000000 --- a/src/proto_alpha/lib_protocol/test/test_dsl.ml +++ /dev/null @@ -1,156 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -open Proto_alpha -open Error_monad -open Helpers_logger -open Isolate_helpers - -exception No_error - -let test_dsl () : unit proto_tzresult Lwt.t = - - Init.main () >>=? fun starting_block -> - let init_tc = starting_block.tezos_context in - - Account.make_2_accounts ~tc: init_tc >>=? fun ((account_a, account_b), init_tc) -> - Account.make_account ~tc: init_tc >>=? fun (_baker, init_tc) -> - let account_unknown_foo = Account.new_account () in - debug "Accounts set" ; - - let default_fee = 10 in - - let transfer ?(tc=init_tc) ?fee a b c = - Apply.transaction_pred - ~tc - ~pred: starting_block - (a,b,c, fee) - in - let originate ?(tc=init_tc) ?fee ?(spendable=true) ?(delegatable=true) a b = - let fee = Option.unopt ~default:default_fee fee in - Apply.origination_pred - ~tc - ~pred: starting_block - (a, b, spendable, delegatable, fee) - in - - (* Send from a sender with no balance (never seen). *) - (* TODO: Is it OK to get Storage_error and not something more specific? *) - transfer - account_unknown_foo - account_b - 10000 >|= Assert.unknown_contract ~msg: __LOC__ >>= fun _ -> - debug "Transfer from no balance V2" ; - - (* Send 1000 tz to unknown account. *) - transfer - account_a - account_unknown_foo - 10000 >>= Assert.ok >>=? fun (_, tc) -> - Assert.equal_cents_balance ~msg: __LOC__ ~tc (account_unknown_foo.contract, 10000) >>=? fun () -> - debug "Reception" ; - - (* Check that a basic transfer originates no contracts. *) - transfer - ~tc - account_a - account_b - 1000 - >>=? fun (contracts, _) -> - Assert.equal_int ~msg: __LOC__ 0 (List.length contracts) ; - debug "No contracts originated" ; - - (* Check sender/receiver balance post transaction *) - transfer - account_a - account_b - 1000 - >>= Assert.ok ~msg: __LOC__ >>=? fun (_,tc) -> - Assert.equal_cents_balance ~msg: __LOC__ ~tc (account_a.contract, 998990) >>=? fun () -> - Assert.equal_cents_balance ~msg: __LOC__ ~tc (account_b.contract, 1001000) >>=? fun () -> - debug "Transfer balances" ; - - (* Check balance too low. *) - transfer - account_a - account_b - 10000000 - >|= Assert.balance_too_low ~msg: __LOC__ >>= fun _ -> - debug "Too low" ; - - (* Check non-spendability of a non-spendable contract *) - (* TODO: Unspecified economic error: should be more specific. *) - originate - ~spendable: false - account_a - 1000 - >>= Assert.ok ~msg: __LOC__ >>=? fun (contracts, tc) -> - Assert.equal_int (List.length contracts) 1 ; - let non_spendable = List.hd contracts in - let account = {account_a with contract = non_spendable} in - debug "Contract created" ; - transfer account account_b 50 ~tc >>= Assert.wrap >>= fun result -> - Assert.non_spendable ~msg: __LOC__ result ; - debug "Non Spendable" ; - - (* Check spendability of a spendable contract *) - originate - ~spendable: true - ~fee: 100 - account_a - 1000 - >>= Assert.ok ~msg: __LOC__ >>=? fun (contracts, spendable_tc) -> - Assert.equal_int (List.length contracts) 1 ; - let contract_spendable = List.hd contracts in - let account_spendable = {account_a with contract = contract_spendable} in - debug "Contract created" ; - transfer account_spendable account_b 50 ~tc: spendable_tc >>= Assert.ok ~msg: __LOC__ >>=? fun _ -> - debug "Spendable" ; - - - (* Try spending a default account with unmatching pk/sk pairs. *) - let account = { account_a with ppk = account_b.ppk } in - transfer - account - account_b - 50 - >>= Assert.wrap >>= fun result -> - Assert.generic_economic_error ~msg: __LOC__ result ; - debug "Unmatching keys" ; - - (* Try spending a default account with keys not matching the - contract pkh. *) - let account = {account_a with contract = account_b.contract } in - transfer - account - account_unknown_foo - 50 - >>= Assert.wrap >>= fun result -> - Assert.inconsistent_pkh ~msg: __LOC__ result ; - debug "Unmatching contract" ; - - (* Try spending an originated contract without the manager's key. *) - let account = {account_b with contract = contract_spendable } in - transfer - ~tc: spendable_tc - account - account_unknown_foo - 50 - >>= Assert.wrap >>= fun result -> - Assert.inconsistent_pkh ~msg: __LOC__ result ; - debug "No manager key" ; - - return () - - -let tests = - List.map - (fun (n, f) -> (n, (fun () -> f () >>= Assert.wrap))) - [ "dsl", test_dsl - ] diff --git a/src/proto_alpha/lib_protocol/test/test_endorsement.ml b/src/proto_alpha/lib_protocol/test/test_endorsement.ml deleted file mode 100644 index 842655f42..000000000 --- a/src/proto_alpha/lib_protocol/test/test_endorsement.ml +++ /dev/null @@ -1,146 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -(* -open Proto_alpha -open Alpha_context -open Error_monad - -let name = "Isolate Endorsement" -module Logger = Logging.Make(struct let name = name end) - -exception No_error - -open Isolate_helpers -open Shorthands - -let (>>?=) = Assert.(>>?=) - -let test_wrong_slot endorse_a starting_block = - let wrong_slot = function - | Proto_alpha.Baking.Invalid_endorsement_slot _ -> true - | _ -> false - in - endorse_a (-1) starting_block >>?= fun result -> - Assert.economic_error ~msg: __LOC__ wrong_slot result ; - endorse_a 16 starting_block >>?= fun result -> - Assert.economic_error ~msg: __LOC__ wrong_slot result ; - return () - - -let test_wrong_delegate endorse_a starting_block = - let invalid_signature = function - | Proto_alpha.Alpha_context.Operation.Invalid_signature -> true - | _ -> false - in - endorse_a 0 starting_block >>=? endorse_a 1 >>=? endorse_a 2 >>= Assert.wrap >>= fun result -> - Assert.economic_error ~msg: __LOC__ invalid_signature result ; - return () - -let test_endorsement_payment () = - Init.main () >>=? fun root -> - let bootstrap_accounts = Account.bootstrap_accounts in - let open Proto_alpha.Alpha_context in - get_tc_full root >>=? fun tc -> - let level = Level.succ tc @@ Level.current tc in - Alpha_services.Delegate.endorsement_rights tc level None >>=? fun (_, endorsers) -> - - let aux (endorser_slot, block_priority) = - let contract_p = - Misc.find_account bootstrap_accounts - @@ List.nth endorsers endorser_slot in - Contract.get_balance tc (Contract.implicit_contract contract_p.hpub) >>=? fun init_balance -> - - (* After one block, endorsement deposit cost should be paid *) - Block.endorsement - root.tezos_header.shell root.hash - root.level block_priority contract_p - root.validation.context endorser_slot - >>=? fun result -> - get_balance_res contract_p result >>=? fun deposit_balance -> - let protocol_data = Block.get_protocol_data block_priority in - Proto_alpha.Baking.check_baking_rights - result.tezos_context protocol_data root.tezos_header.shell.timestamp - >>=? fun baker_pub -> - let baker_hpub = Signature.Public_key.hash baker_pub in - let endorsement_security_deposit = - Constants.endorsement_security_deposit in - let baking = baker_hpub = contract_p.hpub && block_priority < 4 in - let block_security_deposit = - if baking - then Constants.block_security_deposit - else Tez.zero in - let cost = Cast.tez_add endorsement_security_deposit block_security_deposit in - let expected_balance = Cast.tez_sub init_balance cost in - Assert.equal_tez ~msg: __LOC__ expected_balance deposit_balance ; - (* After one cycle, (4 blocks in test/proto_alpha/sandbox), - endorsement reward sould be received *) - chain_empty_block result >>=? chain_empty_block >>=? - chain_empty_block >>=? chain_empty_block >>=? fun result -> - get_balance_res contract_p result >>=? fun reward_balance -> - Proto_alpha.Baking.endorsement_reward ~block_priority >>=? fun reward -> - let expected_balance = Cast.tez_add expected_balance reward in - let expected_balance = Cast.tez_add expected_balance endorsement_security_deposit in - Assert.equal_tez ~msg: __LOC__ expected_balance reward_balance ; - return () - in - let slots = [0 ;1 ;2 ;3 ;4 ;5 ;6 ;7 ;8 ;9 ;10 ;11 ;12 ;13 ;14] in - let prios = [0 ;1 ;2 ;3 ;4 ;5 ;6] in - iter_s aux @@ List.product slots prios - - -let test_multiple_endorsement () = - Init.main () >>=? fun pred -> - let tc = pred.tezos_context in - let level = Level.current tc in - Alpha_services.Delegate.endorsement_rights tc level None >>=? fun (_, endorsers) -> - let endorser = - Misc.find_account Account.bootstrap_accounts - @@ List.nth endorsers 0 in - let op = - Isolate_helpers.Operation.endorsement_full pred.hash level.level, endorser in - Block.of_res ~res: pred ~ops: [op ;op] () >>= Assert.wrap >>= fun x -> - Assert.double_endorsement_evidence ~msg: __LOC__ x ; - return () - - -let test_wrong_endorsement () = - Init.main () >>=? fun starting_block -> - let account = Account.new_account () in - let endorse slot (res: Block.result) = - Block.endorsement - res.tezos_header.shell res.hash res.level - 15 account res.validation.context slot - in - test_wrong_delegate endorse starting_block >>=? fun () -> - test_wrong_slot endorse starting_block - - -let test_fitness () = - Init.main () >>=? fun res -> - Block.of_res ~priority: 0 ~res () >>=? fun block_0 -> - let fitness_0 = block_0.validation.fitness in - Block.of_res ~priority: 1 ~res () >>=? fun block_1 -> - let fitness_1 = block_1.validation.fitness in - let diff = Fitness.compare fitness_0 fitness_1 in - Assert.equal_int ~msg: "Fitness test" diff 0 ; - return () -let tests = - List.map - (fun (n, f) -> (n, (fun () -> f () >>= Assert.wrap))) - [ - "endorsement.payment", test_endorsement_payment ; - "endorsement.wrong", test_wrong_endorsement ; - "endorsement.multiple", test_multiple_endorsement ; - "endorsement.fitness", test_fitness ; - ] - -*) - -let tests = [] diff --git a/src/proto_alpha/lib_protocol/test/test_michelson.ml b/src/proto_alpha/lib_protocol/test/test_michelson.ml deleted file mode 100644 index 7b4f9461a..000000000 --- a/src/proto_alpha/lib_protocol/test/test_michelson.ml +++ /dev/null @@ -1,508 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -open Proto_alpha - -let name = "Isolate Michelson" -module Logger = Logging.Make(struct let name = name end) - -let (//) = Filename.concat -let contract_path = - try Sys.argv.(1) with _ -> Filename.dirname Sys.executable_name // "contracts" - -open Logger - -open Isolate_helpers -open Shorthands - -let (>>??) = Assert.(>>??) -let (>>=??) = Assert.(>>=??) - -let parse_param s : Proto_alpha.Alpha_context.Script.expr = - let (parsed, _) = Michelson_v1_parser.parse_expression s in - parsed.expanded - - -let parse_script code_str storage_str : Proto_alpha.Alpha_context.Script.t = - let code = Script_repr.lazy_expr (parse_param code_str) in - let storage = Script_repr.lazy_expr (parse_param storage_str) in - let return: Proto_alpha.Alpha_context.Script.t = {code ; storage} in - return - - -let program param st code = - let storage s = " storage " ^ s ^ " ; \n" in - let parameter s = " parameter " ^ s ^ " ; \n" in - "{\n" ^ (storage st) ^ (parameter param) ^ " " ^ code ^ "}" - -let quote s = "\"" ^ s ^ "\"" - -open Apply_operation_result - -let extract_result rs = - List.fold_left - (fun (acc, err) (_, r) -> - match r with - | Applied (Transaction_result { originated_contracts } - | Origination_result { originated_contracts }) -> - (originated_contracts @ acc, err) - | Applied Reveal_result - | Applied Delegation_result - | Skipped -> (acc, err) - | Failed errs -> (acc, errs)) - ([], []) rs - -let parse_execute sb ?tc code_str param_str storage_str = - let param = parse_param param_str in - let script = parse_script code_str storage_str in - Script.execute_code_pred ?tc sb script param - >>=?? fun (dst, { ctxt = tc ; operations = ops ; big_map_diff = bgm }) -> - let payer = - (List.hd Account.bootstrap_accounts).contract in - Proto_alpha.Apply.apply_internal_manager_operations tc Readable ~payer ops >>= function - | Error result -> - let _, err = extract_result result in - Lwt.return (Alpha_environment.wrap_error (Error_monad.error (List.hd err))) - | Ok (tc, _) -> - Proto_alpha.Alpha_context.Contract.originated_from_current_nonce tc >>=?? fun contracts -> - let tc = Proto_alpha.Alpha_context.Gas.set_unlimited tc in - Proto_alpha.Alpha_context.Contract.get_storage tc dst >>=?? begin function - | (_, None) -> assert false - | (tc, Some st) -> return (st, ops, tc, contracts, bgm) - end - -let test ctxt ?tc (file_name: string) (storage: string) (input: string) = - let full_path = contract_path // file_name ^ ".tz" in - let file = Helpers_misc.read_file full_path in - let spaced_file = Re.Str.(global_replace (regexp_string "\n") "\n " file) in - let program = "{" ^ spaced_file ^ "}" in - parse_execute ctxt ?tc program input storage - -let test_fails ctxt ?location f s i = - test ctxt f s i >>= fun x -> - let msg = Option.unopt ~default:"Not failing" location in - Assert.generic_economic_error ~msg x ; - return () - -let string_of_canon output_prim = - let output_can = Proto_alpha.Michelson_v1_primitives.strings_of_prims output_prim in - let location_maker _ = - let ret : Micheline_printer.location = {comment=None} in - ret in - let output_node = Micheline.inject_locations location_maker output_can in - Format.fprintf - Format.str_formatter "%a" Micheline_printer.print_expr output_node ; - let output = Format.flush_str_formatter () in - output - -let test_print ctxt fn s i = - test ctxt fn s i >>=? fun (sp, _, _, _, _bgm) -> - let ss = string_of_canon sp in - debug "Storage : %s" ss ; - return () - -let test_tc ctxt ?tc (file_name: string) (storage: string) (input: string) = - test ctxt ?tc file_name storage input >>=? fun (_storage_prim, _output_prim, tc, _contracts, _bgm) -> - return (tc) - - -let test_contract ctxt ?tc (file_name: string) (storage: string) (input: string) = - test ctxt ?tc file_name storage input >>=? fun (_storage_prim, _output_prim, tc, contracts, _bgm) -> - return (contracts, tc) - - - -let test_storage ctxt ?location (file_name: string) (storage: string) (input: string) (expected_storage: string) = - let msg = Option.unopt ~default:"strings aren't equal" location in - generic_trace "%s" msg @@ - test ctxt file_name storage input >>=? fun (storage_prim, _output_prim, _tc, _contracts, _bgm) -> - let storage = string_of_canon storage_prim in - Assert.equal_string ~msg expected_storage storage ; - return () - -let test_success ctxt ?location (file_name: string) (storage: string) (input: string) = - let msg = Option.unopt ~default:"strings aren't equal" location in - generic_trace "%s" msg @@ - test ctxt file_name storage input >>=? fun (_storage_prim, _output_prim, _tc, _contracts, _bgm) -> - return () - - -let test_example () = - Init.main () >>=?? fun sb -> - let test_output ?location a b c d = - test_storage sb ?location a b c d >>= function - | Ok(x) -> return x - | Error(errs) -> ( - match location with - | None -> () - | Some(loc) -> debug "loc : %s" loc - ) ; Lwt.return (Error(errs)) - in - let test_fails ?location = test_fails ?location sb in - let test_success ?location = test_success ?location sb in - let test_tc ?tc = test_tc ?tc sb in - let test_contract ?tc = test_contract ?tc sb in - (* let test_print ?location = test_print ?location sb in*) - let test_storage ?location = test_storage ?location sb in - - (* FORMAT: assert_output contract_file storage input expected_result *) - test_output ~location: __LOC__ "ret_int" "None" "Unit" "(Some 300)" >>=? fun _ -> - - (* Identity on strings *) - test_output ~location: __LOC__ "str_id" "None" "\"Hello\"" "(Some \"Hello\")" >>=? fun _ -> - test_output ~location: __LOC__ "str_id" "None" "\"abcd\"" "(Some \"abcd\")" >>=? fun _ -> - - (* Identity on pairs *) - test_output ~location: __LOC__ "pair_id" "None" "(Pair True False)" "(Some (Pair True False))" >>=? fun _ -> - test_output ~location: __LOC__ "pair_id" "None" "(Pair False True)" "(Some (Pair False True))" >>=? fun _ -> - test_output ~location: __LOC__ "pair_id" "None" "(Pair True True)" "(Some (Pair True True))" >>=? fun _ -> - test_output ~location: __LOC__ "pair_id" "None" "(Pair False False)" "(Some (Pair False False))" >>=? fun _ -> - - (* Logical not *) - test_output ~location: __LOC__ "not" "None" "True" "(Some False)" >>=? fun _ -> - test_output ~location: __LOC__ "not" "None" "False" "(Some True)" >>=? fun _ -> - - (* Logical and *) - test_output ~location: __LOC__ "and" "None" "(Pair False False)" "(Some False)" >>=? fun _ -> - test_output ~location: __LOC__ "and" "None" "(Pair False True)" "(Some False)" >>=? fun _ -> - test_output ~location: __LOC__ "and" "None" "(Pair True False)" "(Some False)" >>=? fun _ -> - test_output ~location: __LOC__ "and" "None" "(Pair True True)" "(Some True)" >>=? fun _ -> - - (* Logical or *) - test_output ~location: __LOC__ "or" "None" "(Pair False False)" "(Some False)" >>=? fun _ -> - test_output ~location: __LOC__ "or" "None" "(Pair False True)" "(Some True)" >>=? fun _ -> - test_output ~location: __LOC__ "or" "None" "(Pair True False)" "(Some True)" >>=? fun _ -> - test_output ~location: __LOC__ "or" "None" "(Pair True True)" "(Some True)" >>=? fun _ -> - - (* XOR *) - test_output ~location: __LOC__ "xor" "None" "(Pair False False)" "(Some False)" >>=? fun _ -> - test_output ~location: __LOC__ "xor" "None" "(Pair False True)" "(Some True)" >>=? fun _ -> - test_output ~location: __LOC__ "xor" "None" "(Pair True False)" "(Some True)" >>=? fun _ -> - test_output ~location: __LOC__ "xor" "None" "(Pair True True)" "(Some False)" >>=? fun _ -> - - - (* Build list *) - test_output ~location: __LOC__ "build_list" "{111}" "0" "{ 0 }" >>=? fun _ -> - test_output ~location: __LOC__ "build_list" "{111}" "3" "{ 0 ; 1 ; 2 ; 3 }" >>=? fun _ -> - test_output ~location: __LOC__ "build_list" "{111}" "10" "{ 0 ; 1 ; 2 ; 3 ; 4 ; 5 ; 6 ; 7 ; 8 ; 9 ; 10 }" >>=? fun _ -> - - (* Concatenate all strings of a list into one string *) - test_output ~location: __LOC__ "concat_list" "\"?\"" "{ \"a\" ; \"b\" ; \"c\" }" "\"abc\"" >>=? fun _ -> - test_output ~location: __LOC__ "concat_list" "\"?\"" "{}" "\"\"" >>=? fun _ -> - test_output ~location: __LOC__ "concat_list" "\"?\"" "{ \"Hello\" ; \" \" ; \"World\" ; \"!\" }" "\"Hello World!\"" >>=? fun _ -> - - (* Find maximum int in list -- returns None if not found *) - test_output ~location: __LOC__ "max_in_list" "None" "{}" "None" >>=? fun _ -> - test_output ~location: __LOC__ "max_in_list" "None" "{ 1 }" "(Some 1)" >>=? fun _ -> - test_output ~location: __LOC__ "max_in_list" "None" "{ -1 }" "(Some -1)" >>=? fun _ -> - test_output ~location: __LOC__ "max_in_list" "None" "{ 10 ; -1 ; -20 ; 100 ; 0 }" "(Some 100)" >>=? fun _ -> - test_output ~location: __LOC__ "max_in_list" "None" "{ 10 ; -1 ; -20 ; 100 ; 0 }" "(Some 100)" >>=? fun _ -> - test_output ~location: __LOC__ "max_in_list" "None" "{ -10 ; -1 ; -20 ; -100 }" "(Some -1)" >>=? fun _ -> - - (* Identity on lists *) - test_output ~location: __LOC__ "list_id" "{\"?\"}" "{ \"1\" ; \"2\" ; \"3\" }" "{ \"1\" ; \"2\" ; \"3\" }" >>=? fun _ -> - test_output ~location: __LOC__ "list_id" "{\"?\"}" "{}" "{}" >>=? fun _ -> - test_output ~location: __LOC__ "list_id" "{\"?\"}" "{ \"a\" ; \"b\" ; \"c\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ -> - - test_output ~location: __LOC__ "list_id_map" "{\"?\"}" "{ \"1\" ; \"2\" ; \"3\" }" "{ \"1\" ; \"2\" ; \"3\" }" >>=? fun _ -> - test_output ~location: __LOC__ "list_id_map" "{\"?\"}" "{}" "{}" >>=? fun _ -> - test_output ~location: __LOC__ "list_id_map" "{\"?\"}" "{ \"a\" ; \"b\" ; \"c\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ -> - - - (* Identity on maps *) - test_output ~location: __LOC__ "map_id" "{}" "{ Elt 0 1 }" "{ Elt 0 1 }" >>=? fun _ -> - test_output ~location: __LOC__ "map_id" "{}" "{ Elt 0 0 }" "{ Elt 0 0 }" >>=? fun _ -> - test_output ~location: __LOC__ "map_id" "{}" "{ Elt 0 0 ; Elt 3 4 }" "{ Elt 0 0 ; Elt 3 4 }" >>=? fun _ -> - - (* Map block on lists *) - test_output ~location: __LOC__ "list_map_block" "{111}" "{}" "{}" >>=? fun _ -> - test_output ~location: __LOC__ "list_map_block" "{111}" "{ 1 ; 1 ; 1 ; 1 }" "{ 1 ; 2 ; 3 ; 4 }" >>=? fun _ -> - test_output ~location: __LOC__ "list_map_block" "{111}" "{ 1 ; 2 ; 3 ; 0 }" "{ 1 ; 3 ; 5 ; 3 }" >>=? fun _ -> - - (* List iter *) - test_output ~location: __LOC__ "list_iter" "111" "{ 10 ; 2 ; 1 }" "20" >>=? fun _ -> - test_output ~location: __LOC__ "list_iter" "111" "{ 3 ; 6 ; 9 }" "162" >>=? fun _ -> - - test_output ~location: __LOC__ "list_iter2" "\"?\"" "{ \"a\" ; \"b\" ; \"c\" }" "\"cba\"" >>=? fun _ -> - test_output ~location: __LOC__ "list_iter2" "\"?\"" "{}" "\"\"" >>=? fun _ -> - - - (* Identity on sets *) - test_output ~location: __LOC__ "set_id" "{\"?\"}" "{ \"a\" ; \"b\" ; \"c\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ -> - test_output ~location: __LOC__ "set_id" "{\"?\"}" "{}" "{}" >>=? fun _ -> - test_output ~location: __LOC__ "set_id" "{\"?\"}" "{ \"asdf\" ; \"bcde\" }" "{ \"asdf\" ; \"bcde\" }" >>=? fun _ -> - - (* Set member -- set is in storage *) - test_output ~location: __LOC__ "set_member" "(Pair {} None)" "\"Hi\"" "(Pair {} (Some False))" >>=? fun _ -> - test_output ~location: __LOC__ "set_member" "(Pair { \"Hi\" } None)" "\"Hi\"" "(Pair { \"Hi\" } (Some True))" >>=? fun _ -> - test_output ~location: __LOC__ "set_member" "(Pair { \"Hello\" ; \"World\" } None)" "\"\"" "(Pair { \"Hello\" ; \"World\" } (Some False))" >>=? fun _ -> - - (* Set size *) - test_output ~location: __LOC__ "set_size" "111" "{}" "0" >>=? fun _ -> - test_output ~location: __LOC__ "set_size" "111" "{ 1 }" "1" >>=? fun _ -> - test_output ~location: __LOC__ "set_size" "111" "{ 1 ; 2 ; 3 }" "3" >>=? fun _ -> - test_output ~location: __LOC__ "set_size" "111" "{ 1 ; 2 ; 3 ; 4 ; 5 ; 6 }" "6" >>=? fun _ -> - - (* Set iter *) - test_output ~location: __LOC__ "set_iter" "111" "{}" "0" >>=? fun _ -> - test_output ~location: __LOC__ "set_iter" "111" "{ 1 }" "1" >>=? fun _ -> - test_output ~location: __LOC__ "set_iter" "111" "{ -100 ; 1 ; 2 ; 3 }" "-94" >>=? fun _ -> - - (* Map size *) - test_output ~location: __LOC__ "map_size" "111" "{}" "0" >>=? fun _ -> - test_output ~location: __LOC__ "map_size" "111" "{ Elt \"a\" 1 }" "1" >>=? fun _ -> - test_output ~location: __LOC__ "map_size" "111" "{ Elt \"a\" 1 ; Elt \"b\" 2 ; Elt \"c\" 3 }" "3" >>=? fun _ -> - test_output ~location: __LOC__ "map_size" "111" "{ Elt \"a\" 1 ; Elt \"b\" 2 ; Elt \"c\" 3 ; Elt \"d\" 4 ; Elt \"e\" 5 ; Elt \"f\" 6 }" "6" >>=? fun _ -> - - (* Contains all elements -- does the second list contain all of the same elements *) - (* as the first one? I'm ignoring element multiplicity *) - test_output ~location: __LOC__ "contains_all" "None" "(Pair {} {})" "(Some True)" >>=? fun _ -> - test_output ~location: __LOC__ "contains_all" "None" "(Pair { \"a\" } { \"B\" })" "(Some False)" >>=? fun _ -> - test_output ~location: __LOC__ "contains_all" "None" "(Pair { \"A\" } { \"B\" })" "(Some False)" >>=? fun _ -> - test_output ~location: __LOC__ "contains_all" "None" "(Pair { \"B\" } { \"B\" })" "(Some True)" >>=? fun _ -> - test_output ~location: __LOC__ "contains_all" "None" "(Pair { \"B\" ; \"C\" ; \"asdf\" } { \"B\" ; \"B\" ; \"asdf\" ; \"C\" })" "(Some True)" >>=? fun _ -> - test_output ~location: __LOC__ "contains_all" "None" "(Pair { \"B\" ; \"B\" ; \"asdf\" ; \"C\" } { \"B\" ; \"C\" ; \"asdf\" })" "(Some True)" >>=? fun _ -> - - (* Concatenate the string in storage with all strings in the given list *) - test_output ~location: __LOC__ "concat_hello" "{\"?\"}" "{ \"World!\" }" "{ \"Hello World!\" }" >>=? fun _ -> - test_output ~location: __LOC__ "concat_hello" "{\"?\"}" "{}" "{}" >>=? fun _ -> - test_output ~location: __LOC__ "concat_hello" "{\"?\"}" "{ \"test1\" ; \"test2\" }" "{ \"Hello test1\" ; \"Hello test2\" }" >>=? fun _ -> - - (* Create an empty map and add a string to it *) - test_output ~location: __LOC__ "empty_map" "{}" "Unit" "{ Elt \"hello\" \"world\" }" >>=? fun _ -> - - (* Get the value stored at the given key in the map *) - test_output ~location: __LOC__ "get_map_value" "(Pair None { Elt \"hello\" \"hi\" })" "\"hello\"" "(Pair (Some \"hi\") { Elt \"hello\" \"hi\" })" >>=? fun _ -> - test_output ~location: __LOC__ "get_map_value" "(Pair None { Elt \"hello\" \"hi\" }" "\"\"" "(Pair None { Elt \"hello\" \"hi\" })" >>=? fun _ -> - test_output ~location: __LOC__ "get_map_value" "(Pair None { Elt \"1\" \"one\" ; Elt \"2\" \"two\" })" "\"1\"" "(Pair (Some \"one\") { Elt \"1\" \"one\" ; Elt \"2\" \"two\" })" >>=? fun _ -> - - (* Map iter *) - test_output ~location: __LOC__ "map_iter" "(Pair 3 3)" "{ Elt 0 100 ; Elt 2 100 }" "(Pair 2 200)" >>=? fun _ -> - test_output ~location: __LOC__ "map_iter" "(Pair 3 3)" "{ Elt 1 1 ; Elt 2 100 }" "(Pair 3 101)" >>=? fun _ -> - - (* Return True if True branch of if was taken and False otherwise *) - test_output ~location: __LOC__ "if" "None" "True" "(Some True)" >>=? fun _ -> - test_output ~location: __LOC__ "if" "None" "False" "(Some False)" >>=? fun _ -> - - (* Generate a pair of or types *) - test_output ~location: __LOC__ "swap_left_right" "(Left \"\")" "(Left True)" "(Right True)" >>=? fun _ -> - test_output ~location: __LOC__ "swap_left_right" "(Right False)" "(Right \"a\")" "(Left \"a\")" >>=? fun _ -> - - (* Reverse a list *) - test_output ~location: __LOC__ "reverse" "{\"?\"}" "{}" "{}" >>=? fun _ -> - test_output ~location: __LOC__ "reverse" "{\"?\"}" "{ \"c\" ; \"b\" ; \"a\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ -> - test_output ~location: __LOC__ "reverse_loop" "{\"?\"}" "{}" "{}" >>=? fun _ -> - test_output ~location: __LOC__ "reverse_loop" "{\"?\"}" "{ \"c\" ; \"b\" ; \"a\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ -> - - (* Reverse using LOOP_LEFT *) - test_output ~location: __LOC__ "loop_left" "{\"?\"}" "{}" "{}" >>=? fun _ -> - test_output ~location: __LOC__ "loop_left" "{\"?\"}" "{ \"c\" ; \"b\" ; \"a\" }" "{ \"a\" ; \"b\" ; \"c\" }" >>=? fun _ -> - - (* Exec concat contract *) - test_output ~location: __LOC__ "exec_concat" "\"?\"" "\"\"" "\"_abc\"" >>=? fun _ -> - test_output ~location: __LOC__ "exec_concat" "\"?\"" "\"test\"" "\"test_abc\"" >>=? fun _ -> - - (* Get current steps to quota *) - test_output ~location: __LOC__ "steps_to_quota" "111" "Unit" "399992" >>=? fun _ -> - - let bootstrap_0 = List.nth Account.bootstrap_accounts 0 in - get_balance_res bootstrap_0 sb >>=?? fun _balance -> - let amount = string_of_int (Script.init_amount * 10000) in - (* Get the current balance of the contract *) - test_output ~location: __LOC__ "balance" "111000000" "Unit" amount >>=? fun _ -> - - (* Test comparisons on tez { EQ ; GT ; LT ; GE ; LE } *) - test_output ~location: __LOC__ "compare" "{}" "(Pair 1000000 2000000)" "{ False ; False ; True ; False ; True }" >>=? fun _ -> - test_output ~location: __LOC__ "compare" "{}" "(Pair 2000000 1000000)" "{ False ; True ; False ; True ; False }" >>=? fun _ -> - test_output ~location: __LOC__ "compare" "{}" "(Pair 2370000 2370000)" "{ True ; False ; False ; True ; True }" >>=? fun _ -> - - (* Test addition and subtraction on tez *) - test_output ~location: __LOC__ "tez_add_sub" "None" "(Pair 2000000 1000000)" "(Some (Pair 3000000 1000000))" >>=? fun _ -> - test_output ~location: __LOC__ "tez_add_sub" "None" "(Pair 2310000 1010000)" "(Some (Pair 3320000 1300000))" >>=? fun _ -> - - (* Test get first element of list *) - test_output ~location: __LOC__ "first" "111" "{ 1 ; 2 ; 3 ; 4 }" "1" >>=? fun _ -> - test_output ~location: __LOC__ "first" "111" "{ 4 }" "4" >>=? fun _ -> - - (* Hash input string *) - (* Test assumed to be correct -- hash is based on encoding of AST *) - test_output ~location: __LOC__ "hash_string" "\"?\"" "\"abcdefg\"" "\"exprv3MnhXvjthGzZ7jDtXRRFremZyey9rsGtL7JRkeaQX1fThN7WF\"" >>=? fun _ -> - test_output ~location: __LOC__ "hash_string" "\"?\"" "\"12345\"" "\"expru81QVHsW2qaWLNHnMHSxDNhqtat17ajadri6mKUvXyc2EWHZC3\"" >>=? fun _ -> - - (* Test ASSERT *) - test_output ~location: __LOC__ "assert" "Unit" "True" "Unit" >>=? fun _ -> - test_fails ~location: __LOC__ "assert" "Unit" "False" >>=? fun _ -> - - (* COMPARE ; ASSERT_ *) - test_output ~location: __LOC__ "assert_eq" "Unit" "(Pair -1 -1)" "Unit" >>=? fun _ -> - test_fails ~location: __LOC__ "assert_eq" "Unit" "(Pair 0 -1)" >>=? fun _ -> - - test_output ~location: __LOC__ "assert_eq" "Unit" "(Pair -1 -1)" "Unit" >>=? fun _ -> - test_fails ~location: __LOC__ "assert_eq" "Unit" "(Pair 0 -1)" >>=? fun _ -> - - test_output ~location: __LOC__ "assert_neq" "Unit" "(Pair 0 -1)" "Unit" >>=? fun _ -> - test_fails ~location: __LOC__ "assert_neq" "Unit" "(Pair -1 -1)" >>=? fun _ -> - - test_output ~location: __LOC__ "assert_lt" "Unit" "(Pair -1 0)" "Unit" >>=? fun _ -> - test_fails ~location: __LOC__ "assert_lt" "Unit" "(Pair 0 -1)" >>=? fun _ -> - test_fails ~location: __LOC__ "assert_lt" "Unit" "(Pair 0 0)" >>=? fun _ -> - - test_output ~location: __LOC__ "assert_le" "Unit" "(Pair 0 0)" "Unit" >>=? fun _ -> - test_output ~location: __LOC__ "assert_le" "Unit" "(Pair -1 0)" "Unit" >>=? fun _ -> - test_fails ~location: __LOC__ "assert_le" "Unit" "(Pair 0 -1)" >>=? fun _ -> - - test_output ~location: __LOC__ "assert_gt" "Unit" "(Pair 0 -1)" "Unit" >>=? fun _ -> - test_fails ~location: __LOC__ "assert_gt" "Unit" "(Pair -1 0)" >>=? fun _ -> - test_fails ~location: __LOC__ "assert_gt" "Unit" "(Pair 0 0)" >>=? fun _ -> - - test_output ~location: __LOC__ "assert_ge" "Unit" "(Pair 0 0)" "Unit" >>=? fun _ -> - test_output ~location: __LOC__ "assert_ge" "Unit" "(Pair 0 -1)" "Unit" >>=? fun _ -> - test_fails ~location: __LOC__ "assert_ge" "Unit" "(Pair -1 0)" >>=? fun _ -> - - (* ASSERT_CMP *) - test_output ~location: __LOC__ "assert_cmpeq" "Unit" "(Pair -1 -1)" "Unit" >>=? fun _ -> - test_fails ~location: __LOC__ "assert_cmpeq" "Unit" "(Pair 0 -1)" >>=? fun _ -> - - test_output ~location: __LOC__ "assert_cmpeq" "Unit" "(Pair -1 -1)" "Unit" >>=? fun _ -> - test_fails ~location: __LOC__ "assert_cmpeq" "Unit" "(Pair 0 -1)" >>=? fun _ -> - - test_output ~location: __LOC__ "assert_cmpneq" "Unit" "(Pair 0 -1)" "Unit" >>=? fun _ -> - test_fails ~location: __LOC__ "assert_cmpneq" "Unit" "(Pair -1 -1)" >>=? fun _ -> - - test_output ~location: __LOC__ "assert_cmplt" "Unit" "(Pair -1 0)" "Unit" >>=? fun _ -> - test_fails ~location: __LOC__ "assert_cmplt" "Unit" "(Pair 0 -1)" >>=? fun _ -> - test_fails ~location: __LOC__ "assert_cmplt" "Unit" "(Pair 0 0)" >>=? fun _ -> - - test_output ~location: __LOC__ "assert_cmple" "Unit" "(Pair 0 0)" "Unit" >>=? fun _ -> - test_output ~location: __LOC__ "assert_cmple" "Unit" "(Pair -1 0)" "Unit" >>=? fun _ -> - test_fails ~location: __LOC__ "assert_cmple" "Unit" "(Pair 0 -1)" >>=? fun _ -> - - test_output ~location: __LOC__ "assert_cmpgt" "Unit" "(Pair 0 -1)" "Unit" >>=? fun _ -> - test_fails ~location: __LOC__ "assert_cmpgt" "Unit" "(Pair -1 0)" >>=? fun _ -> - test_fails ~location: __LOC__ "assert_cmpgt" "Unit" "(Pair 0 0)" >>=? fun _ -> - - test_output ~location: __LOC__ "assert_cmpge" "Unit" "(Pair 0 0)" "Unit" >>=? fun _ -> - test_output ~location: __LOC__ "assert_cmpge" "Unit" "(Pair 0 -1)" "Unit" >>=? fun _ -> - test_fails ~location: __LOC__ "assert_cmpge" "Unit" "(Pair -1 0)" >>=? fun _ -> - - (* IF_SOME *) - test_output ~location: __LOC__ "if_some" "\"?\"" "(Some \"hello\")" "\"hello\"" >>=? fun _ -> - test_output ~location: __LOC__ "if_some" "\"?\"" "None" "\"\"" >>=? fun _ -> - - (* Tests the SET_CAR and SET_CDR instructions *) - test_output ~location: __LOC__ "set_car" "(Pair \"hello\" 0)" "\"world\"" "(Pair \"world\" 0)" >>=? fun _ -> - test_output ~location: __LOC__ "set_car" "(Pair \"hello\" 0)" "\"abc\"" "(Pair \"abc\" 0)" >>=? fun _ -> - test_output ~location: __LOC__ "set_car" "(Pair \"hello\" 0)" "\"\"" "(Pair \"\" 0)" >>=? fun _ -> - - test_output ~location: __LOC__ "set_cdr" "(Pair \"hello\" 0)" "1" "(Pair \"hello\" 1)" >>=? fun _ -> - test_output ~location: __LOC__ "set_cdr" "(Pair \"hello\" 500)" "3" "(Pair \"hello\" 3)" >>=? fun _ -> - test_output ~location: __LOC__ "set_cdr" "(Pair \"hello\" 7)" "100" "(Pair \"hello\" 100)" >>=? fun _ -> - - test_storage ~location: __LOC__ "set_caddaadr" "(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 0) 4) 5))) 6)" "3000000" "(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 3000000) 4) 5))) 6)" >>=? fun _ -> - - test_storage ~location: __LOC__ "map_caddaadr" "(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 0) 4) 5))) 6)" "Unit" "(Pair (Pair 1 (Pair 2 (Pair (Pair (Pair 3 1000000) 4) 5))) 6)" >>=? fun _ -> - - (* Did the given key sign the string? (key is bootstrap1) *) - test_success ~location: __LOC__ "check_signature" "(Pair \"edsigtbsm9RwhfQuJWSmZrvbDqDR9t1TJs34KrX4wkt9uUJ4PJG1aT6uLDiCqKz6vcGZAbNpoW7PvXUzdXo1E3c6ap6GoUU366J\" \"hello\")" "\"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\"" >>=? fun _ -> - - test_fails ~location: __LOC__ "check_signature" "(Pair \"edsigtbsm9RwhfQuJWSmZrvbDqDR9t1TJs34KrX4wkt9uUJ4PJG1aT6uLDiCqKz6vcGZAbNpoW7PvXUzdXo1E3c6ap6GoUU366J\" \"abcd\")" "\"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\"" >>=? fun _ -> - - (* Convert a public key to a public key hash *) - test_output ~location: __LOC__ "hash_key" "None" "\"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\"" "(Some \"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx\")" >>=? fun _ -> - test_output ~location: __LOC__ "hash_key" "None" "\"edpkuJqtDcA2m2muMxViSM47MPsGQzmyjnNTawUPqR8vZTAMcx61ES\"" "(Some \"tz1XPTDmvT3vVE5Uunngmixm7gj7zmdbPq6k\")" >>=? fun _ -> - - (* Test timestamp operations *) - test_output ~location: __LOC__ "add_timestamp_delta" "None" "(Pair 100 100)" "(Some \"1970-01-01T00:03:20Z\")" >>=? fun _ -> - test_output ~location: __LOC__ "add_timestamp_delta" "None" "(Pair 100 -100)" "(Some \"1970-01-01T00:00:00Z\")" >>=? fun _ -> - test_output ~location: __LOC__ "add_timestamp_delta" "None" "(Pair \"1970-01-01T00:00:00Z\" 0)" "(Some \"1970-01-01T00:00:00Z\")" >>=? fun _ -> - - test_output ~location: __LOC__ "add_delta_timestamp" "None" "(Pair 100 100)" "(Some \"1970-01-01T00:03:20Z\")" >>=? fun _ -> - test_output ~location: __LOC__ "add_delta_timestamp" "None" "(Pair -100 100)" "(Some \"1970-01-01T00:00:00Z\")" >>=? fun _ -> - test_output ~location: __LOC__ "add_delta_timestamp" "None" "(Pair 0 \"1970-01-01T00:00:00Z\")" "(Some \"1970-01-01T00:00:00Z\")" >>=? fun _ -> - - test_output ~location: __LOC__ "sub_timestamp_delta" "111" "(Pair 100 100)" "\"1970-01-01T00:00:00Z\"" >>=? fun _ -> - test_output ~location: __LOC__ "sub_timestamp_delta" "111" "(Pair 100 -100)" "\"1970-01-01T00:03:20Z\"" >>=? fun _ -> - test_output ~location: __LOC__ "sub_timestamp_delta" "111" "(Pair 100 2000000000000000000)" "-1999999999999999900" >>=? fun _ -> - - test_output ~location: __LOC__ "diff_timestamps" "111" "(Pair 0 0)" "0" >>=? fun _ -> - test_output ~location: __LOC__ "diff_timestamps" "111" "(Pair 0 1)" "-1" >>=? fun _ -> - test_output ~location: __LOC__ "diff_timestamps" "111" "(Pair 1 0)" "1" >>=? fun _ -> - test_output ~location: __LOC__ "diff_timestamps" "111" "(Pair \"1970-01-01T00:03:20Z\" \"1970-01-01T00:00:00Z\")" "200" >>=? fun _ -> - - (* Test internal operations *) - test_output ~location: __LOC__ "cps_fact" "0" "4" "24" >>=? fun _ -> - - (* Test NOW *) - let now = sb.tezos_header.shell.timestamp in - let now_str = quote @@ Tezos_base.Time.to_notation now in - test_storage ~location: __LOC__ "store_now" "\"1970-01-01T00:03:20Z\"" "Unit" now_str >>=? fun _ -> - - (* Test TRANSFER_TO *) - Account.make_account ~tc: sb.tezos_context >>=?? fun (account, tc) -> - let account_str = quote @@ Signature.Public_key_hash.to_b58check account.hpub in - test_tc ~tc "transfer_to" "Unit" account_str >>=? fun tc -> - let amount = Account.init_amount + 100 in - Assert.equal_cents_balance ~tc (account.contract, amount * 100) >>=?? fun _ -> - - (* Test CREATE_ACCOUNT *) - Account.make_account ~tc: sb.tezos_context >>=?? fun (_, tc) -> - test_contract ~tc "create_account" "None" ("(Left " ^ account_str ^ ")") >>=? fun (cs, tc) -> - Assert.equal_int 1 @@ List.length cs ; - - (* Test CREATE_CONTRACT *) - test_contract ~tc "create_contract" "Unit" ("(Left " ^ account_str ^ ")") >>=? fun (cs, tc) -> - Assert.equal_int 1 @@ List.length cs ; - let contract = List.hd cs in - Proto_alpha.Alpha_context.Contract.get_script tc contract >>=?? fun (_, res) -> - let script = Option.unopt_exn (Failure "get_script") res in - Script.execute_code_pred ~tc sb script (parse_param "\"abc\"") >>=?? fun (_, { storage }) -> - Assert.equal_string ~msg: __LOC__ "\"abc\"" @@ string_of_canon storage ; - - (* Test IMPLICIT_ACCOUNT *) - let account = Account.new_account () in - let b_str = quote @@ Signature.Public_key_hash.to_b58check account.hpub in - test_contract ~tc "default_account" "Unit" b_str >>=? fun (_cs, tc) -> - Assert.equal_cents_balance ~tc (account.contract, 100 * 100) >>=?? fun _ -> - return () - - -let test_program () = - Init.main () >>=?? fun sb -> - let id_code = "code - { CAR ; - NIL operation ; - PAIR }" in - let id_int_program = - program "int" "int" id_code in - let id_ill_param_program = - program "string" "string" id_code in - let id_ill_return_program = - program "int" "int" "code {}" in - let id_pbool_program = - program "(pair bool bool)" "(pair bool bool)" id_code in - let push_300_code = "code - { DROP ; - PUSH nat 300 ; - NIL operation ; - PAIR }" in - let push_300 = - program "unit" "nat" push_300_code in - parse_execute sb id_int_program "2" "3" >>=? fun _ -> - parse_execute sb id_ill_param_program "2" "3" >>= fun x -> - Assert.ill_typed_data_error ~msg: "Good data type" x ; - parse_execute sb id_ill_return_program "2" "3" >>= fun x -> - Assert.ill_typed_return_error ~msg: "Good return type" x ; - parse_execute sb push_300 "Unit" "111" >>=? fun _ -> - parse_execute sb id_pbool_program "(Pair True True)" "(Pair False False)" >>=? fun _ -> - return () - -let tests = [ - "example", (fun _ -> test_example ()) ; - "program", (fun _ -> test_program ()) ; -] diff --git a/src/proto_alpha/lib_protocol/test/test_origination.ml b/src/proto_alpha/lib_protocol/test/test_origination.ml deleted file mode 100644 index 87a406766..000000000 --- a/src/proto_alpha/lib_protocol/test/test_origination.ml +++ /dev/null @@ -1,78 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -open Proto_alpha -open Error_monad - -let name = "Isolate Origination" -module Logger = Logging.Make(struct let name = name end) - -exception No_error - -open Isolate_helpers -open Helpers_block -let (>>?=) = Assert.(>>?=) -let (>>=??) = Assert.(>>=??) - -let originate root ?(tc=root.tezos_context) ?spendable ?fee ?delegatable src amount = - let delegatable = Option.unopt ~default:true delegatable in - let spendable = Option.unopt ~default:true spendable in - let fee = Option.unopt ~default:10 fee in - Apply.origination_pred - ~tc - ~pred: root - (src, amount, spendable, delegatable, fee) - -let test_simple_origination () = - - Init.main () >>=? fun root -> - let src = List.hd Account.bootstrap_accounts in - - (* 2. Balance should work *) - originate root src 200 >>= Assert.ok >>= fun _ -> - return () - - -let delegate root ?(tc=root.tezos_context) ?fee src delegate = - let fee = Option.unopt ~default:10 fee in - Apply.delegation_pred - ~tc - ~pred: root - (src, delegate, fee) - -let test_delegation () = - - Init.main () >>=? fun root -> - let account_a = List.nth Account.bootstrap_accounts 0 in - let account_b = List.nth Account.bootstrap_accounts 1 in - - (* Delegatable should change delegate *) - originate root ~delegatable: true account_a 200 - >>=? fun (contracts, tc) -> - let contract = List.hd contracts in - let account_ac = {account_a with contract} in - delegate root ~tc account_ac account_b.hpub >>= Assert.ok ~msg: __LOC__ >>= fun _ -> - - (* Not-Delegatable should not change delegate *) - originate root ~delegatable: false account_a 200 - >>=? fun (contracts, tc) -> - let contract = List.hd contracts in - let account_a = {account_a with contract} in - delegate root ~tc account_a account_b.hpub >>= Assert.wrap >>= fun res -> - Assert.non_delegatable ~msg: __LOC__ res ; - - return () - -let tests = - List.map - (fun (n, f) -> (n, (fun () -> f () >>= Assert.wrap))) - [ "simple", test_simple_origination ; - "delegate", test_delegation ; - ] - diff --git a/src/proto_alpha/lib_protocol/test/test_transaction.ml b/src/proto_alpha/lib_protocol/test/test_transaction.ml deleted file mode 100644 index e3f0704e6..000000000 --- a/src/proto_alpha/lib_protocol/test/test_transaction.ml +++ /dev/null @@ -1,153 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2016. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -open Proto_alpha -open Error_monad - -let name = "Isolate Transactions" -module Logger = Logging.Make(struct let name = name end) -open Logger - -module Helpers = Isolate_helpers -module Assert = Helpers.Assert - -let test_basic (): unit tzresult Lwt.t = - Helpers.Init.main () >>=? fun starting_block -> - let init_tc = starting_block.tezos_context in - - Helpers.Account.make_2_accounts ~tc: init_tc >>=? fun ((account_a, account_b), init_tc) -> - Helpers.Account.make_account ~tc: init_tc >>=? fun (_baker, init_tc) -> - let account_unknown_foo = Helpers.Account.new_account () in - debug "Accounts set" ; - - let transfer ?(tc=init_tc) ?fee (src, dst, amount) = - Helpers.Apply.transaction_pred - ~tc - ~pred: starting_block - (src, dst, amount, fee) - in - let originate ?(tc=init_tc) = - Helpers.Apply.origination_pred - ~tc - ~pred: starting_block - in - - let init_amount = Helpers.Account.init_amount in - - (* Send from a sender with no balance (never seen). *) - (* TODO: Is it OK to get Storage_error and not something more specific? *) - transfer (account_unknown_foo, account_b, 10000) >|= - Assert.unknown_contract ~msg: __LOC__ >>= fun _ -> - debug "Transfer from no balance V2" ; - - (* Send 10 tz to unknown account. *) - transfer (account_a, account_unknown_foo, 10000) >>= - Assert.ok >>=? fun (_, tc) -> - Assert.equal_cents_balance ~msg: __LOC__ ~tc (account_unknown_foo.contract, 10000) >>=? fun () -> - debug "Reception" ; - - (* Unknown account transfers back tz. *) - transfer ~tc (account_unknown_foo, account_a, 9990) >>= - Assert.ok >>=? fun _ -> - debug "Transfer back" ; - - (* Check that a basic transfer originates no contracts. *) - transfer (account_a, account_b, 1000) >>=? fun (contracts, _) -> - Assert.equal_int ~msg: __LOC__ 0 (List.length contracts) ; - debug "No contracts originated" ; - - (* Check sender/receiver balance post transaction *) - transfer (account_a, account_b, 1000) >>= - Assert.ok ~msg: __LOC__ >>=? fun (_,tc) -> - Proto_alpha.Alpha_context.Contract.get_balance tc account_a.contract >>=? fun _balance -> - Assert.equal_cents_balance ~msg: __LOC__ ~tc (account_a.contract, init_amount * 100 - 1000 - 10) >>=? fun () -> - Assert.equal_cents_balance ~msg: __LOC__ ~tc (account_b.contract, 1001000) >>=? fun () -> - debug "Transfer balances" ; - - (* Check balance too low. *) - transfer (account_a, account_b, 10000000) >|= - Assert.balance_too_low ~msg: __LOC__ >>= fun _ -> - debug "Too low" ; - - (* Check non-spendability of a non-spendable contract *) - (* TODO: Unspecified economic error: should be more specific. *) - originate (account_a, 1000, false, true, 0) - >>= Assert.ok ~msg: __LOC__ >>=? fun (contracts, tc) -> - Assert.equal_int (List.length contracts) 1 ; - let non_spendable = List.hd contracts in - let account = {account_a with contract = non_spendable} in - debug "Contract created" ; - - transfer (account, account_b, 50) ~tc >>= Assert.wrap >>= fun result -> - Assert.non_spendable ~msg: __LOC__ result ; - debug "Non Spendable" ; - - (* Check spendability of a spendable contract *) - originate (account_a, 1000, true, true, 100) - >>= Assert.ok ~msg: __LOC__ >>=? fun (contracts, spendable_tc) -> - Assert.equal_int (List.length contracts) 1 ; - let contract_spendable = List.hd contracts in - let account_spendable = {account_a with contract = contract_spendable} in - debug "Contract created" ; - transfer (account_spendable, account_b, 50) ~tc: spendable_tc >>= Assert.ok ~msg: __LOC__ >>=? fun _ -> - debug "Spendable" ; - - - (* Try spending a default account with unmatching pk/sk pairs. *) - let account = { account_a with ppk = account_b.ppk } in - transfer (account, account_b, 50) - >>= Assert.wrap >>= fun result -> - Assert.generic_economic_error ~msg: __LOC__ result ; - debug "Unmatching keys" ; - - (* Try spending a default account with keys not matching the - contract pkh. *) - let account = {account_a with contract = account_b.contract } in - transfer (account, account_unknown_foo, 50) - >>= Assert.wrap >>= fun result -> - Assert.inconsistent_pkh ~msg: __LOC__ result ; - debug "Unmatching contract" ; - - (* Try spending an originated contract without the manager's key. *) - let account = {account_b with contract = contract_spendable } in - transfer - ~tc: spendable_tc - (account, account_unknown_foo, 50) - >>= Assert.wrap >>= fun result -> - Assert.inconsistent_pkh ~msg: __LOC__ result ; - debug "No manager key" ; - return () - -let test_cycle_transfer () = - Helpers.Init.main () >>=? fun pred -> - let transfer = Helpers.Apply.transaction_pred ~pred in - let tc = pred.tezos_context in - let cycle n = - Helpers.Account.make_accounts ~tc n >>=? fun (accounts, tc) -> - let pairs = List.combine accounts @@ List.shift accounts in - let aux tc (src, dst) = - transfer ~tc (src, dst, 10000, Some(10)) >>=? fun (_, tc) -> return tc - in - fold_left_s aux tc pairs >>=? fun tc -> - let aux (account: Helpers.Account.t) = - Helpers.Assert.equal_cents_balance ~tc ~msg: __LOC__ (account.contract, Helpers.Account.init_amount * 100 - 10) - in - iter_s aux accounts - in - cycle 2 >>=? fun _ -> - cycle 13 >>=? fun _ -> - cycle 50 >>=? fun _ -> - return () - -let tests = - List.map - (fun (n, f) -> (n, (fun () -> f () >>= Assert.wrap))) - [ "transaction.basic", test_basic ; - "transaction.cycle_transfer", test_cycle_transfer - ]