From f739624185fdefe278c99be2542b1684e323b24a Mon Sep 17 00:00:00 2001 From: Tom Jack Date: Sat, 2 Nov 2019 17:38:39 -0500 Subject: [PATCH 1/3] Prepare for tezos upgrade --- vendors/ligo-utils/proto-alpha-utils/proto-alpha-utils.opam | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/vendors/ligo-utils/proto-alpha-utils/proto-alpha-utils.opam b/vendors/ligo-utils/proto-alpha-utils/proto-alpha-utils.opam index 6c16581a6..e0cf3abfd 100644 --- a/vendors/ligo-utils/proto-alpha-utils/proto-alpha-utils.opam +++ b/vendors/ligo-utils/proto-alpha-utils/proto-alpha-utils.opam @@ -18,9 +18,8 @@ depends: [ "ezjsonm" "hex" "hidapi" - # opam does not handle tezos' constraints well (why?) - "ipaddr" { >= "3.1.0" & < "4.0.0" } - "macaddr" { >= "3.1.0" & < "4.0.0" } + "ipaddr" + "macaddr" "irmin" "js_of_ocaml" "lwt" From b06f4d3f62a1ac4e196a6ba46bf0fe80a40a9c23 Mon Sep 17 00:00:00 2001 From: Tom Jack Date: Sat, 2 Nov 2019 17:54:21 -0500 Subject: [PATCH 2/3] Delete protocol tests --- .../tezos-protocol-alpha/test/activation.ml | 371 ------ .../tezos-protocol-alpha/test/baking.ml | 98 -- .../test/combined_operations.ml | 229 ---- .../test/contracts/cps_fact.tz | 16 - .../test/contracts/cps_fact_2.tz | 14 - .../tezos-protocol-alpha/test/delegation.ml | 1171 ----------------- .../test/double_baking.ml | 189 --- .../test/double_endorsement.ml | 204 --- .../ligo-utils/tezos-protocol-alpha/test/dune | 46 - .../tezos-protocol-alpha/test/endorsement.ml | 441 ------- .../test/helpers/account.ml | 92 -- .../test/helpers/account.mli | 57 - .../test/helpers/assert.ml | 124 -- .../test/helpers/block.ml | 418 ------ .../test/helpers/block.mli | 137 -- .../test/helpers/context.ml | 285 ---- .../test/helpers/context.mli | 119 -- .../tezos-protocol-alpha/test/helpers/dune | 19 - .../test/helpers/incremental.ml | 188 --- .../test/helpers/incremental.mli | 51 - .../test/helpers/nonce.ml | 33 - .../test/helpers/nonce.mli | 31 - .../tezos-protocol-alpha/test/helpers/op.ml | 337 ----- .../tezos-protocol-alpha/test/helpers/op.mli | 114 -- .../test/helpers/test_tez.ml | 61 - .../test/helpers/test_utils.ml | 43 - .../tezos-005-PsBabyM1-test-helpers.opam | 21 - .../tezos-protocol-alpha/test/main.ml | 41 - .../tezos-protocol-alpha/test/origination.ml | 235 ---- .../tezos-protocol-alpha/test/qty.ml | 141 -- .../tezos-protocol-alpha/test/rolls.ml | 250 ---- .../tezos-protocol-alpha/test/seed.ml | 223 ---- .../tezos-protocol-alpha/test/test.ml | 35 - .../tezos-protocol-alpha/test/transfer.ml | 597 --------- .../tezos-protocol-alpha/test/voting.ml | 943 ------------- .../tezos-protocol-005-PsBabyM1-tests.opam | 32 - 36 files changed, 7406 deletions(-) delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/activation.ml delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/baking.ml delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/combined_operations.ml delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/contracts/cps_fact.tz delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/contracts/cps_fact_2.tz delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/delegation.ml delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/double_baking.ml delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/double_endorsement.ml delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/dune delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/endorsement.ml delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/helpers/account.ml delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/helpers/account.mli delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/helpers/assert.ml delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/helpers/block.ml delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/helpers/block.mli delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/helpers/context.ml delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/helpers/context.mli delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/helpers/dune delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/helpers/incremental.ml delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/helpers/incremental.mli delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/helpers/nonce.ml delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/helpers/nonce.mli delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/helpers/op.ml delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/helpers/op.mli delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/helpers/test_tez.ml delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/helpers/test_utils.ml delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/helpers/tezos-005-PsBabyM1-test-helpers.opam delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/main.ml delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/origination.ml delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/qty.ml delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/rolls.ml delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/seed.ml delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/test.ml delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/transfer.ml delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/test/voting.ml delete mode 100644 vendors/ligo-utils/tezos-protocol-alpha/tezos-protocol-005-PsBabyM1-tests.opam diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/activation.ml b/vendors/ligo-utils/tezos-protocol-alpha/test/activation.ml deleted file mode 100644 index 2078e9602..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/activation.ml +++ /dev/null @@ -1,371 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -(** The activation operation creates an implicit contract from a - registered commitment present in the context. It is parametrized by - a public key hash (pkh) and a secret. - - The commitments are composed of : - - a blinded pkh that can be revealed by the secret ; - - an amount. - - The commitments and the secrets are generated from - /scripts/create_genesis/create_genenis.py and should be coherent. -*) - -open Protocol -open Alpha_context -open Test_utils -open Test_tez - -(* Generated commitments and secrets *) - -(* Commitments are hard-coded in {Tezos_proto_alpha_parameters.Default_parameters} *) - -(* let commitments = - * List.map (fun (bpkh, a) -> - * Commitment_repr.{ - * blinded_public_key_hash=Blinded_public_key_hash.of_b58check_exn bpkh ; - * amount = Tez_repr.of_mutez_exn (Int64.of_string a)} - * ) - * [ ( "btz1bRL4X5BWo2Fj4EsBdUwexXqgTf75uf1qa", "23932454669343" ) ; - * ( "btz1SxjV1syBgftgKy721czKi3arVkVwYUFSv", "72954577464032" ) ; - * ( "btz1LtoNCjiW23txBTenALaf5H6NKF1L3c1gw", "217487035428349" ) ; - * ( "btz1SUd3mMhEBcWudrn8u361MVAec4WYCcFoy", "4092742372031" ) ; - * ( "btz1MvBXf4orko1tsGmzkjLbpYSgnwUjEe81r", "17590039016550" ) ; - * ( "btz1LoDZ3zsjgG3k3cqTpUMc9bsXbchu9qMXT", "26322312350555" ) ; - * ( "btz1RMfq456hFV5AeDiZcQuZhoMv2dMpb9hpP", "244951387881443" ) ; - * ( "btz1Y9roTh4A7PsMBkp8AgdVFrqUDNaBE59y1", "80065050465525" ) ; - * ( "btz1Q1N2ePwhVw5ED3aaRVek6EBzYs1GDkSVD", "3569618927693" ) ; - * ( "btz1VFFVsVMYHd5WfaDTAt92BeQYGK8Ri4eLy", "9034781424478" ) ; - * ] *) - -type secret_account = { - account : public_key_hash ; - activation_code : Blinded_public_key_hash.activation_code ; - amount : Tez.t ; -} - -let secrets () = - (* Exported from proto_alpha client - TODO : remove when relocated to lib_crypto *) - let read_key mnemonic email password = - match Bip39.of_words mnemonic with - | None -> assert false - | Some t -> - (* TODO: unicode normalization (NFKD)... *) - let passphrase = MBytes.(concat "" [ - of_string email ; - of_string password ; - ]) in - let sk = Bip39.to_seed ~passphrase t in - let sk = MBytes.sub sk 0 32 in - let sk : Signature.Secret_key.t = - Ed25519 (Data_encoding.Binary.of_bytes_exn Ed25519.Secret_key.encoding sk) in - let pk = Signature.Secret_key.to_public_key sk in - let pkh = Signature.Public_key.hash pk in - (pkh, pk, sk) - in - List.map (fun (mnemonic, secret, amount, pkh, password, email) -> - let (pkh', pk, sk) = read_key mnemonic email password in - let pkh = Signature.Public_key_hash.of_b58check_exn pkh in - assert (Signature.Public_key_hash.equal pkh pkh'); - let account = Account.{ pkh ; pk ; sk } in - Account.add_account account ; - { account = account.pkh ; - activation_code = Blinded_public_key_hash.activation_code_of_hex secret ; - amount = Option.unopt_exn (Invalid_argument "tez conversion") - (Tez.of_mutez (Int64.of_string amount)) - }) - [ - (["envelope"; "hospital"; "mind"; "sunset"; "cancel"; "muscle"; "leisure"; - "thumb"; "wine"; "market"; "exit"; "lucky"; "style"; "picnic"; "success"], - "0f39ed0b656509c2ecec4771712d9cddefe2afac", - "23932454669343", - "tz1MawerETND6bqJqx8GV3YHUrvMBCDasRBF", - "z0eZHQQGKt", - "cjgfoqmk.wpxnvnup@tezos.example.org" - ); - (["flag"; "quote"; "will"; "valley"; "mouse"; "chat"; "hold"; "prosper"; - "silk"; "tent"; "cruel"; "cause"; "demise"; "bottom"; "practice"], - "41f98b15efc63fa893d61d7d6eee4a2ce9427ac4", - "72954577464032", - "tz1X4maqF9tC1Yn4jULjHRAyzjAtc25Z68TX", - "MHErskWPE6", - "oklmcktr.ztljnpzc@tezos.example.org" - ); - (["library"; "away"; "inside"; "paper"; "wise"; "focus"; "sweet"; "expose"; - "require"; "change"; "stove"; "planet"; "zone"; "reflect"; "finger"], - "411dfef031eeecc506de71c9df9f8e44297cf5ba", - "217487035428348", - "tz1SWBY7rWMutEuWS54Pt33MkzAS6eWkUuTc", - "0AO6BzQNfN", - "ctgnkvqm.kvtiybky@tezos.example.org" - ); - (["cruel"; "fluid"; "damage"; "demand"; "mimic"; "above"; "village"; "alpha"; - "vendor"; "staff"; "absent"; "uniform"; "fire"; "asthma"; "milk"], - "08d7d355bc3391d12d140780b39717d9f46fcf87", - "4092742372031", - "tz1amUjiZaevaxQy5wKn4SSRvVoERCip3nZS", - "9kbZ7fR6im", - "bnyxxzqr.tdszcvqb@tezos.example.org" - ) ; - (["opera"; "divorce"; "easy"; "myself"; "idea"; "aim"; "dash"; "scout"; - "case"; "resource"; "vote"; "humor"; "ticket"; "client"; "edge"], - "9b7cad042fba557618bdc4b62837c5f125b50e56", - "17590039016550", - "tz1Zaee3QBtD4ErY1SzqUvyYTrENrExu6yQM", - "suxT5H09yY", - "iilkhohu.otnyuvna@tezos.example.org" - ) ; - (["token"; "similar"; "ginger"; "tongue"; "gun"; "sort"; "piano"; "month"; - "hotel"; "vote"; "undo"; "success"; "hobby"; "shell"; "cart"], - "124c0ca217f11ffc6c7b76a743d867c8932e5afd", - "26322312350555", - "tz1geDUUhfXK1EMj7VQdRjug1MoFe6gHWnCU", - "4odVdLykaa", - "kwhlglvr.slriitzy@tezos.example.org" - ) ; - (["shield"; "warrior"; "gorilla"; "birth"; "steak"; "neither"; "feel"; - "only"; "liberty"; "float"; "oven"; "extend"; "pulse"; "suffer"; "vapor"], - "ac7a2125beea68caf5266a647f24dce9fea018a7", - "244951387881443", - "tz1h3nY7jcZciJgAwRhWcrEwqfVp7VQoffur", - "A6yeMqBFG8", - "lvrmlbyj.yczltcxn@tezos.example.org" - ) ; - (["waste"; "open"; "scan"; "tip"; "subway"; "dance"; "rent"; "copper"; - "garlic"; "laundry"; "defense"; "clerk"; "another"; "staff"; "liar"], - "2b3e94be133a960fa0ef87f6c0922c19f9d87ca2", - "80065050465525", - "tz1VzL4Xrb3fL3ckvqCWy6bdGMzU2w9eoRqs", - "oVZqpq60sk", - "rfodmrha.zzdndvyk@tezos.example.org" - ) ; - (["fiber"; "next"; "property"; "cradle"; "silk"; "obey"; "gossip"; - "push"; "key"; "second"; "across"; "minimum"; "nice"; "boil"; "age"], - "dac31640199f2babc157aadc0021cd71128ca9ea", - "3569618927693", - "tz1RUHg536oRKhPLFfttcB5gSWAhh4E9TWjX", - "FfytQTTVbu", - "owecikdy.gxnyttya@tezos.example.org" - ) ; - (["print"; "labor"; "budget"; "speak"; "poem"; "diet"; "chunk"; "eternal"; - "book"; "saddle"; "pioneer"; "ankle"; "happy"; "only"; "exclude"], - "bb841227f250a066eb8429e56937ad504d7b34dd", - "9034781424478", - "tz1M1LFbgctcPWxstrao9aLr2ECW1fV4pH5u", - "zknAl3lrX2", - "ettilrvh.zsrqrbud@tezos.example.org" - ) ; - ] - -let activation_init () = - Context.init ~with_commitments:true 1 >>=? fun (b, cs) -> - secrets () |> fun ss -> - return (b, cs, ss) - -let simple_init_with_commitments () = - activation_init () >>=? fun (blk, _contracts, _secrets) -> - Block.bake blk >>=? fun _ -> - return_unit - -(** A single activation *) -let single_activation () = - activation_init () >>=? fun (blk, _contracts, secrets) -> - let { account ; activation_code ; amount=expected_amount ; _ } as _first_one = List.hd secrets in - - (* Contract does not exist *) - Assert.balance_is ~loc:__LOC__ (B blk) (Contract.implicit_contract account) Tez.zero >>=? fun () -> - - Op.activation (B blk) account activation_code >>=? fun operation -> - Block.bake ~operation blk >>=? fun blk -> - - (* Contract does exist *) - Assert.balance_is ~loc:__LOC__ (B blk) (Contract.implicit_contract account) expected_amount - -(** 10 activations, one per bake *) -let multi_activation_1 () = - activation_init () >>=? fun (blk, _contracts, secrets) -> - - Error_monad.fold_left_s (fun blk { account ; activation_code ; amount = expected_amount ; _ } -> - Op.activation (B blk) account activation_code >>=? fun operation -> - Block.bake ~operation blk >>=? fun blk -> - - Assert.balance_is ~loc:__LOC__ (B blk) (Contract.implicit_contract account) expected_amount >>=? fun () -> - - return blk - ) blk secrets >>=? fun _ -> - return_unit - -(** All in one bake *) -let multi_activation_2 () = - activation_init () >>=? fun (blk, _contracts, secrets) -> - - Error_monad.fold_left_s (fun ops { account ; activation_code ; _ } -> - Op.activation (B blk) account activation_code >>=? fun op -> - return (op::ops) - ) [] secrets >>=? fun ops -> - - Block.bake ~operations:ops blk >>=? fun blk -> - - Error_monad.iter_s (fun { account ; amount = expected_amount ; _ } -> - (* Contract does exist *) - Assert.balance_is ~loc:__LOC__ (B blk) (Contract.implicit_contract account) expected_amount - ) secrets - -(** Transfer with activated account *) -let activation_and_transfer () = - activation_init () >>=? fun (blk, contracts, secrets) -> - let { account ; activation_code ; _ } as _first_one = List.hd secrets in - let bootstrap_contract = List.hd contracts in - let first_contract = Contract.implicit_contract account in - - Op.activation (B blk) account activation_code >>=? fun operation -> - Block.bake ~operation blk >>=? fun blk -> - - Context.Contract.balance (B blk) bootstrap_contract >>=? fun amount -> - Tez.(/?) amount 2L >>?= fun half_amount -> - Context.Contract.balance (B blk) first_contract >>=? fun activated_amount_before -> - - Op.transaction (B blk) bootstrap_contract first_contract half_amount >>=? fun operation -> - Block.bake ~operation blk >>=? fun blk -> - - Assert.balance_was_credited ~loc:__LOC__ (B blk) (Contract.implicit_contract account) activated_amount_before half_amount - -(** Transfer to an unactivated account and then activating it *) -let transfer_to_unactivated_then_activate () = - activation_init () >>=? fun (blk, contracts, secrets) -> - let { account ; activation_code ; amount } as _first_one = List.hd secrets in - let bootstrap_contract = List.hd contracts in - let unactivated_commitment_contract = Contract.implicit_contract account in - - Context.Contract.balance (B blk) bootstrap_contract >>=? fun b_amount -> - Tez.(/?) b_amount 2L >>?= fun b_half_amount -> - - Incremental.begin_construction blk >>=? fun inc -> - Op.transaction (I inc) bootstrap_contract unactivated_commitment_contract b_half_amount >>=? fun op -> - Incremental.add_operation inc op >>=? fun inc -> - Op.activation (I inc) account activation_code >>=? fun op' -> - Incremental.add_operation inc op' >>=? fun inc -> - Incremental.finalize_block inc >>=? fun blk2 -> - - Assert.balance_was_credited ~loc:__LOC__ (B blk2) (Contract.implicit_contract account) amount b_half_amount - -(****************************************************************) -(* The following test scenarios are supposed to raise errors. *) -(****************************************************************) - -(** Invalid pkh activation : expected to fail as the context does not - contain any commitment *) -let invalid_activation_with_no_commitments () = - Context.init 1 >>=? fun (blk, _) -> - let secrets = secrets () in - let { account ; activation_code ; _ } as _first_one = List.hd secrets in - - Op.activation (B blk) account activation_code >>=? fun operation -> - Block.bake ~operation blk >>= fun res -> - - Assert.proto_error ~loc:__LOC__ res begin function - | Apply.Invalid_activation _ -> true - | _ -> false - end - -(** Wrong activation : wrong secret given in the operation *) -let invalid_activation_wrong_secret () = - activation_init () >>=? fun (blk, _, secrets) -> - let { account ; _ } as _first_one = List.nth secrets 0 in - let { activation_code ; _ } as _second_one = List.nth secrets 1 in - - Op.activation (B blk) account activation_code >>=? fun operation -> - Block.bake ~operation blk >>= fun res -> - - Assert.proto_error ~loc:__LOC__ res begin function - | Apply.Invalid_activation _ -> true - | _ -> false - end - -(** Invalid pkh activation : expected to fail as the context does not - contain an associated commitment *) -let invalid_activation_inexistent_pkh () = - activation_init () >>=? fun (blk, _, secrets) -> - let { activation_code ; _ } as _first_one = List.hd secrets in - let inexistent_pkh = Signature.Public_key_hash.of_b58check_exn - "tz1PeQHGKPWSpNoozvxgqLN9TFsj6rDqNV3o" in - - Op.activation (B blk) inexistent_pkh activation_code >>=? fun operation -> - Block.bake ~operation blk >>= fun res -> - - Assert.proto_error ~loc:__LOC__ res begin function - | Apply.Invalid_activation _ -> true - | _ -> false - end - -(** Invalid pkh activation : expected to fail as the commitment has - already been claimed *) -let invalid_double_activation () = - activation_init () >>=? fun (blk, _, secrets) -> - let { account ; activation_code ; _ } as _first_one = List.hd secrets in - Incremental.begin_construction blk >>=? fun inc -> - - Op.activation (I inc) account activation_code >>=? fun op -> - Incremental.add_operation inc op >>=? fun inc -> - Op.activation (I inc) account activation_code >>=? fun op' -> - Incremental.add_operation inc op' >>= fun res -> - - Assert.proto_error ~loc:__LOC__ res begin function - | Apply.Invalid_activation _ -> true - | _ -> false - end - -(** Transfer from an unactivated commitment account *) -let invalid_transfer_from_unactived_account () = - activation_init () >>=? fun (blk, contracts, secrets) -> - let { account ; _ } as _first_one = List.hd secrets in - let bootstrap_contract = List.hd contracts in - let unactivated_commitment_contract = Contract.implicit_contract account in - - (* No activation *) - - Op.transaction (B blk) unactivated_commitment_contract bootstrap_contract Tez.one >>=? fun operation -> - Block.bake ~operation blk >>= fun res -> - - Assert.proto_error ~loc:__LOC__ res begin function - | Contract_storage.Empty_implicit_contract pkh -> if pkh = account then true else false - | _ -> false - end - -let tests = [ - Test.tztest "init with commitments" `Quick simple_init_with_commitments ; - Test.tztest "single activation" `Quick single_activation ; - Test.tztest "multi-activation one-by-one" `Quick multi_activation_1 ; - Test.tztest "multi-activation all at a time" `Quick multi_activation_2 ; - Test.tztest "activation and transfer" `Quick activation_and_transfer ; - Test.tztest "transfer to unactivated account then activate" `Quick transfer_to_unactivated_then_activate ; - Test.tztest "invalid activation with no commitments" `Quick invalid_activation_with_no_commitments ; - Test.tztest "invalid activation with commitments" `Quick invalid_activation_inexistent_pkh ; - Test.tztest "invalid double activation" `Quick invalid_double_activation ; - Test.tztest "wrong activation code" `Quick invalid_activation_wrong_secret ; - Test.tztest "invalid transfer from unactivated account" `Quick invalid_transfer_from_unactived_account -] diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/baking.ml b/vendors/ligo-utils/tezos-protocol-alpha/test/baking.ml deleted file mode 100644 index 053b29779..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/baking.ml +++ /dev/null @@ -1,98 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol -open Alpha_context -open Test_utils - -(** Tests for [bake_n] and [bake_until_end_cycle]. *) -let test_cycle () = - Context.init 5 >>=? fun (b,_) -> - Context.get_constants (B b) >>=? fun csts -> - let blocks_per_cycle = csts.parametric.blocks_per_cycle in - - let pp = fun fmt x -> Format.fprintf fmt "%ld" x in - - (* Tests that [bake_until_cycle_end] returns a block at - level [blocks_per_cycle]. *) - Block.bake b >>=? fun b -> - Block.bake_until_cycle_end b >>=? fun b -> - Context.get_level (B b) >>=? fun curr_level -> - Assert.equal ~loc:__LOC__ Int32.equal "not the right level" pp - (Alpha_context.Raw_level.to_int32 curr_level) - blocks_per_cycle >>=? fun () -> - - (* Tests that [bake_n n] bakes [n] blocks. *) - Context.get_level (B b) >>=? fun l -> - Block.bake_n 10 b >>=? fun b -> - Context.get_level (B b) >>=? fun curr_level -> - Assert.equal ~loc:__LOC__ Int32.equal "not the right level" pp - (Alpha_context.Raw_level.to_int32 curr_level) - (Int32.add (Alpha_context.Raw_level.to_int32 l) 10l) - - -(** Tests the formula introduced in Emmy+ for block reward: - (16/(p+1)) * (0.8 + 0.2 * e / 32) - where p is the block priority and - e is the number of included endorsements *) -let test_block_reward priority () = - begin match priority with - | 0 -> Test_tez.Tez.((of_int 128) /? Int64.of_int 10) >>?= fun min -> - return (Test_tez.Tez.of_int 16, min) - | 1 -> Test_tez.Tez.((of_int 64) /? Int64.of_int 10) >>?= fun min -> - return (Test_tez.Tez.of_int 8, min) - | 3 -> Test_tez.Tez.((of_int 32) /? Int64.of_int 10) >>?= fun min -> - return (Test_tez.Tez.of_int 4, min) - | _ -> fail (invalid_arg "prio should be 0, 1, or 3") - end >>=? fun (expected_reward_max_endo, expected_reward_min_endo) -> - let endorsers_per_block = 32 in - Context.init ~endorsers_per_block 32 >>=? fun (b, _) -> - - Context.get_endorsers (B b) >>=? fun endorsers -> - fold_left_s (fun ops (endorser : Alpha_services.Delegate.Endorsing_rights.t) -> - let delegate = endorser.delegate in - Op.endorsement ~delegate (B b) () >>=? fun op -> - return (Operation.pack op :: ops) - ) [] endorsers >>=? fun ops -> - Block.bake - ~policy:(By_priority 0) - ~operations:ops - b >>=? fun b -> - (* bake a block at priority 0 and 32 endorsements; - the reward is 16 tez *) - Context.get_baking_reward (B b) ~priority ~endorsing_power:32 >>=? fun baking_reward -> - Assert.equal_tez ~loc:__LOC__ baking_reward expected_reward_max_endo >>=? fun () -> - (* bake a block at priority 0 and 0 endorsements; - the reward is 12.8 tez *) - Context.get_baking_reward (B b) ~priority ~endorsing_power:0 >>=? fun baking_reward -> - Assert.equal_tez ~loc:__LOC__ baking_reward expected_reward_min_endo - - -let tests = [ - Test.tztest "cycle" `Quick (test_cycle) ; - Test.tztest "block_reward for priority 0" `Quick (test_block_reward 0) ; - Test.tztest "block_reward for priority 1" `Quick (test_block_reward 1) ; - Test.tztest "block_reward for priority 3" `Quick (test_block_reward 3) ; -] diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/combined_operations.ml b/vendors/ligo-utils/tezos-protocol-alpha/test/combined_operations.ml deleted file mode 100644 index cdbd56c5e..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/combined_operations.ml +++ /dev/null @@ -1,229 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -(** Multiple operations can be grouped in one ensuring their - derministic application. - - If an invalid operation is present in this group of operation, the - previous applied operations are backtracked leaving the context - unchanged and the following operations are skipped. Fees attributed - to the operations are collected by the baker nonetheless. - - Only manager operations are allowed in multiple transactions. - They must all belong to the same manager as there is only one signature. *) - -open Protocol -open Test_tez -open Test_utils - -let ten_tez = Tez.of_int 10 - -(** Groups ten transactions between the same parties. *) -let multiple_transfers () = - Context.init 3 >>=? fun (blk, contracts) -> - let c1 = List.nth contracts 0 in - let c2 = List.nth contracts 1 in - let c3 = List.nth contracts 2 in - - map_s (fun _ -> - Op.transaction (B blk) c1 c2 Tez.one - ) (1--10) >>=? fun ops -> - - Op.combine_operations ~source:c1 (B blk) ops >>=? fun operation -> - - Context.Contract.balance (B blk) c1 >>=? fun c1_old_balance -> - Context.Contract.balance (B blk) c2 >>=? fun c2_old_balance -> - Context.Contract.pkh c3 >>=? fun baker_pkh -> - Block.bake ~policy:(By_account baker_pkh) ~operation blk >>=? fun blk -> - - Assert.balance_was_debited ~loc:__LOC__ - (B blk) c1 c1_old_balance (Tez.of_int 10) >>=? fun () -> - Assert.balance_was_credited ~loc:__LOC__ - (B blk) c2 c2_old_balance (Tez.of_int 10) >>=? fun () -> - return_unit - - -(** Groups ten delegated originations. *) -let multiple_origination_and_delegation () = - Context.init 2 >>=? fun (blk, contracts) -> - let c1 = List.nth contracts 0 in - let c2 = List.nth contracts 1 in - let n = 10 in - Context.get_constants (B blk) >>=? fun { parametric = { origination_size ; cost_per_byte ; _ } ; _ } -> - Context.Contract.pkh c2 >>=? fun delegate_pkh -> - - (* Deploy n smart contracts with dummy scripts from c1 *) - map_s (fun i -> - Op.origination ~delegate:delegate_pkh ~counter:(Z.of_int i) ~fee:Tez.zero ~script:Op.dummy_script - ~credit:(Tez.of_int 10) (B blk) c1 - ) (1--n) >>=? fun originations -> - - (* These computed originated contracts are not the ones really created *) - (* We will extract them from the tickets *) - let (originations_operations, _) = List.split originations in - - Op.combine_operations ~source:c1 (B blk) originations_operations >>=? fun operation -> - - Context.Contract.balance (B blk) c1 >>=? fun c1_old_balance -> - Incremental.begin_construction blk >>=? fun inc -> - Incremental.add_operation inc operation >>=? fun inc -> - - (* To retrieve the originated contracts, it is easier to extract them - from the tickets. Else, we could (could we ?) hash each combined - operation individually. *) - let tickets = Incremental.rev_tickets inc in - let open Apply_results in - let tickets = - List.fold_left (fun acc -> function - | No_operation_metadata -> assert false - | Operation_metadata { contents } -> - to_list (Contents_result_list contents) @ acc - ) [] tickets |> List.rev in - let new_contracts = - List.map (function - | Contents_result - (Manager_operation_result - { operation_result = - Applied (Origination_result { originated_contracts = [ h ] ; _ }) - ; _ }) -> - h - | _ -> assert false - ) tickets in - - (* Previous balance - (Credit (n * 10tz) + Origination cost (n tz)) *) - Tez.(cost_per_byte *? Int64.of_int origination_size) >>?= fun origination_burn -> - Tez.(origination_burn *? (Int64.of_int n)) >>?= fun origination_total_cost -> - Lwt.return ( - Tez.( *? ) Op.dummy_script_cost 10L >>? - Tez.( +? ) (Tez.of_int (10 * n)) >>? - Tez.( +? ) origination_total_cost ) >>=? fun total_cost -> - Assert.balance_was_debited ~loc:__LOC__ - (I inc) c1 c1_old_balance total_cost >>=? fun () -> - - iter_s (fun c -> - Assert.balance_is ~loc:__LOC__ (I inc) c (Tez.of_int 10) - ) new_contracts >>=? fun () -> - - return_unit - -let expect_balance_too_low = function - | Environment.Ecoproto_error (Contract_storage.Balance_too_low _) :: _ -> - return_unit - | _ -> - failwith "Contract should not have a sufficient balance : operation expected to fail." - -(** Groups three operations, the midlle one failing. - Checks that the receipt is consistent. - Variant without fees. *) -let failing_operation_in_the_middle () = - Context.init 2 >>=? fun (blk, contracts) -> - let c1 = List.nth contracts 0 in - let c2 = List.nth contracts 1 in - - Op.transaction ~fee:Tez.zero (B blk) c1 c2 Tez.one >>=? fun op1 -> - Op.transaction ~fee:Tez.zero (B blk) c1 c2 Tez.max_tez >>=? fun op2 -> - Op.transaction ~fee:Tez.zero (B blk) c1 c2 Tez.one >>=? fun op3 -> - let operations = [ op1 ; op2 ; op3 ] in - - Op.combine_operations ~source:c1 (B blk) operations >>=? fun operation -> - - Context.Contract.balance (B blk) c1 >>=? fun c1_old_balance -> - Context.Contract.balance (B blk) c2 >>=? fun c2_old_balance -> - - Incremental.begin_construction blk >>=? fun inc -> - Incremental.add_operation - ~expect_failure:expect_balance_too_low inc operation >>=? fun inc -> - - let tickets = Incremental.rev_tickets inc in - let open Apply_results in - let tickets = - List.fold_left (fun acc -> function - | No_operation_metadata -> assert false - | Operation_metadata { contents } -> - to_list (Contents_result_list contents) @ acc - ) [] tickets in - begin match tickets with - | Contents_result (Manager_operation_result { operation_result = (Backtracked _) ; _ }) :: - Contents_result (Manager_operation_result { operation_result = Failed (_, [ Contract_storage.Balance_too_low _ ]) ; _ }) :: - Contents_result (Manager_operation_result { operation_result = Skipped _ ; _ }) :: - _ -> () - | _ -> assert false - end ; - - Assert.balance_is ~loc:__LOC__ (I inc) c1 c1_old_balance >>=? fun () -> - Assert.balance_is ~loc:__LOC__ (I inc) c2 c2_old_balance >>=? fun () -> - - return_unit - -(** Groups three operations, the midlle one failing. - Checks that the receipt is consistent. - Variant with fees, that should be spent even in case of failure. *) -let failing_operation_in_the_middle_with_fees () = - Context.init 2 >>=? fun (blk, contracts) -> - let c1 = List.nth contracts 0 in - let c2 = List.nth contracts 1 in - - Op.transaction ~fee:Tez.one (B blk) c1 c2 Tez.one >>=? fun op1 -> - Op.transaction ~fee:Tez.one (B blk) c1 c2 Tez.max_tez >>=? fun op2 -> - Op.transaction ~fee:Tez.one (B blk) c1 c2 Tez.one >>=? fun op3 -> - let operations = [ op1 ; op2 ; op3 ] in - - Op.combine_operations ~source:c1 (B blk) operations >>=? fun operation -> - - Context.Contract.balance (B blk) c1 >>=? fun c1_old_balance -> - Context.Contract.balance (B blk) c2 >>=? fun c2_old_balance -> - - Incremental.begin_construction blk >>=? fun inc -> - Incremental.add_operation - ~expect_failure:expect_balance_too_low inc operation >>=? fun inc -> - - let tickets = Incremental.rev_tickets inc in - let open Apply_results in - let tickets = - List.fold_left (fun acc -> function - | No_operation_metadata -> assert false - | Operation_metadata { contents } -> - to_list (Contents_result_list contents) @ acc - ) [] tickets in - begin match tickets with - | Contents_result (Manager_operation_result { operation_result = (Backtracked _) ; _ }) :: - Contents_result (Manager_operation_result { operation_result = Failed (_, [ Contract_storage.Balance_too_low _ ]) ; _ }) :: - Contents_result (Manager_operation_result { operation_result = Skipped _ ; _ }) :: - _ -> () - | _ -> assert false - end ; - - (* In the presence of a failure, all the fees are collected. Even for skipped operations. *) - Assert.balance_was_debited ~loc:__LOC__ (I inc) c1 c1_old_balance (Tez.of_int 3) >>=? fun () -> - Assert.balance_is ~loc:__LOC__ (I inc) c2 c2_old_balance >>=? fun () -> - - return_unit - -let tests = [ - Test.tztest "multiple transfers" `Quick multiple_transfers ; - Test.tztest "multiple originations and delegations" `Quick multiple_origination_and_delegation ; - Test.tztest "Failing operation in the middle" `Quick failing_operation_in_the_middle ; - Test.tztest "Failing operation in the middle (with fees)" `Quick failing_operation_in_the_middle_with_fees ; -] diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/contracts/cps_fact.tz b/vendors/ligo-utils/tezos-protocol-alpha/test/contracts/cps_fact.tz deleted file mode 100644 index 445ceca44..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/contracts/cps_fact.tz +++ /dev/null @@ -1,16 +0,0 @@ -storage nat ; -parameter nat ; -code { UNPAIR ; - DIP { SELF ; ADDRESS ; SOURCE; - IFCMPEQ {} { DROP ; PUSH @storage nat 1 } }; - DUP ; - PUSH nat 1 ; - IFCMPGE - { DROP ; NIL operation ; PAIR } - { PUSH nat 1 ; SWAP ; SUB @parameter ; ISNAT ; - IF_NONE - { NIL operation ; PAIR } - { DUP ; DIP { PUSH nat 1 ; ADD ; MUL @storage } ; SWAP; - DIP { DIP { SELF; PUSH mutez 0 } ; - TRANSFER_TOKENS ; NIL operation ; SWAP ; CONS } ; - SWAP ; PAIR } } } \ No newline at end of file diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/contracts/cps_fact_2.tz b/vendors/ligo-utils/tezos-protocol-alpha/test/contracts/cps_fact_2.tz deleted file mode 100644 index 5dbcb6167..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/contracts/cps_fact_2.tz +++ /dev/null @@ -1,14 +0,0 @@ -storage unit ; -parameter (pair nat nat) ; -code { CAR ; UNPAIR ; - DUP ; - PUSH nat 1 ; - IFCMPGE - { DROP ; DROP ; UNIT ; NIL operation ; PAIR } - { PUSH nat 1 ; SWAP ; SUB @parameter ; ISNAT ; - IF_NONE - { DROP ; UNIT ; NIL operation ; PAIR } - { DUP ; DIP { PUSH nat 1 ; ADD ; MUL @storage } ; PAIR ; - DIP { SELF; PUSH tez "0" } ; - TRANSFER_TOKENS ; NIL operation ; SWAP ; CONS ; - UNIT ; SWAP ; PAIR } } } \ No newline at end of file diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/delegation.ml b/vendors/ligo-utils/tezos-protocol-alpha/test/delegation.ml deleted file mode 100644 index f27d944f2..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/delegation.ml +++ /dev/null @@ -1,1171 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol -open Alpha_context -open Test_tez -open Test_utils - -(**************************************************************************) -(* bootstrap contracts *) -(**************************************************************************) -(* Bootstrap contracts are heavily used in other tests. It is helpful - to test some properties of these contracts, so we can correctly - interpret the other tests that use them. *) - -let expect_error err = function - | err0 :: _ when err = err0 -> return_unit - | _ -> failwith "Unexpected successful result" - -let expect_alpha_error err = - expect_error (Environment.Ecoproto_error err) - -let expect_no_change_registered_delegate_pkh pkh = function - | Environment.Ecoproto_error (Delegate_storage.No_deletion pkh0) :: _ when pkh0 = pkh -> - return_unit - | _ -> - failwith "Delegate can not be deleted and operation should fail." - -(** bootstrap contracts delegate to themselves *) -let bootstrap_manager_is_bootstrap_delegate () = - Context.init 1 >>=? fun (b, bootstrap_contracts) -> - let bootstrap0 = List.hd bootstrap_contracts in - Context.Contract.delegate (B b) bootstrap0 >>=? fun delegate0 -> - Context.Contract.manager (B b) bootstrap0 >>=? fun manager0 -> - Assert.equal_pkh ~loc:__LOC__ delegate0 manager0.pkh - -(** bootstrap contracts cannot change their delegate *) -let bootstrap_delegate_cannot_change ~fee () = - Context.init 2 >>=? fun (b, bootstrap_contracts) -> - let bootstrap0 = List.nth bootstrap_contracts 0 in - let bootstrap1 = List.nth bootstrap_contracts 1 in - Context.Contract.pkh bootstrap0 >>=? fun pkh1 -> - Incremental.begin_construction b ~policy:(Block.Excluding [pkh1]) >>=? fun i -> - Context.Contract.manager (I i) bootstrap1 >>=? fun manager1 -> - Context.Contract.balance (I i) bootstrap0 >>=? fun balance0 -> - Context.Contract.delegate (I i) bootstrap0 >>=? fun delegate0 -> - (* change delegation to bootstrap1 *) - Op.delegation ~fee (I i) bootstrap0 (Some manager1.pkh) >>=? fun set_delegate -> - if fee > balance0 then - Incremental.add_operation i set_delegate >>= fun err -> - Assert.proto_error ~loc:__LOC__ err (function - | Contract_storage.Balance_too_low _ -> true - | _ -> false) - else - Incremental.add_operation - ~expect_failure:(expect_no_change_registered_delegate_pkh delegate0) - i set_delegate >>=? fun i -> - Incremental.finalize_block i >>=? fun b -> - (* bootstrap0 still has same delegate *) - Context.Contract.delegate (B b) bootstrap0 >>=? fun delegate0_after -> - Assert.equal_pkh ~loc:__LOC__ delegate0_after delegate0 >>=? fun () -> - (* fee has been debited *) - Assert.balance_was_debited ~loc:__LOC__ (B b) bootstrap0 balance0 fee - -(** bootstrap contracts cannot delete their delegation *) -let bootstrap_delegate_cannot_be_removed ~fee () = - Context.init 1 >>=? fun (b, bootstrap_contracts) -> - let bootstrap = List.hd bootstrap_contracts in - Incremental.begin_construction b >>=? fun i -> - Context.Contract.balance (I i) bootstrap >>=? fun balance -> - Context.Contract.delegate (I i) bootstrap >>=? fun delegate -> - Context.Contract.manager (I i) bootstrap >>=? fun manager -> - (* remove delegation *) - Op.delegation ~fee (I i) bootstrap None >>=? fun set_delegate -> - if fee > balance then - Incremental.add_operation i set_delegate >>= fun err -> - Assert.proto_error ~loc:__LOC__ err (function - | Contract_storage.Balance_too_low _ -> true - | _ -> false) - else - Incremental.add_operation - ~expect_failure:(expect_no_change_registered_delegate_pkh manager.pkh) - i set_delegate - >>=? fun i -> - (* delegate has not changed *) - Context.Contract.delegate (I i) bootstrap >>=? fun delegate_after -> - Assert.equal_pkh ~loc:__LOC__ delegate delegate_after >>=? fun () -> - (* fee has been debited *) - Assert.balance_was_debited ~loc:__LOC__ (I i) bootstrap balance fee - -(** contracts not registered as delegate can change their delegation *) -let delegate_can_be_changed_from_unregistered_contract~fee () = - Context.init 2 >>=? fun (b, bootstrap_contracts) -> - let bootstrap0 = List.hd bootstrap_contracts in - let bootstrap1 = List.nth bootstrap_contracts 1 in - let unregistered_account = Account.new_account () in - let unregistered_pkh = Account.(unregistered_account.pkh) in - let unregistered = Contract.implicit_contract unregistered_pkh in - Incremental.begin_construction b >>=? fun i -> - Context.Contract.manager (I i) bootstrap0 >>=? fun manager0 -> - Context.Contract.manager (I i) bootstrap1 >>=? fun manager1 -> - let credit = Tez.of_int 10 in - Op.transaction ~fee:Tez.zero (I i) bootstrap0 unregistered credit >>=? fun credit_contract -> - Context.Contract.balance (I i) bootstrap0 >>=? fun balance -> - Incremental.add_operation i credit_contract >>=? fun i -> - (* delegate to bootstrap0 *) - Op.delegation ~fee:Tez.zero (I i) unregistered (Some manager0.pkh) >>=? fun set_delegate -> - Incremental.add_operation i set_delegate >>=? fun i -> - Context.Contract.delegate (I i) unregistered >>=? fun delegate -> - Assert.equal_pkh ~loc:__LOC__ delegate manager0.pkh >>=? fun () -> - (* change delegation to bootstrap1 *) - Op.delegation ~fee (I i) unregistered (Some manager1.pkh) >>=? fun change_delegate -> - if fee > balance then - Incremental.add_operation i change_delegate >>= fun err -> - Assert.proto_error ~loc:__LOC__ err (function - | Contract_storage.Balance_too_low _ -> true - | _ -> false) - else - Incremental.add_operation i change_delegate >>=? fun i -> - (* delegate has changed *) - Context.Contract.delegate (I i) unregistered >>=? fun delegate_after -> - Assert.equal_pkh ~loc:__LOC__ delegate_after manager1.pkh >>=? fun () -> - (* fee has been debited *) - Assert.balance_was_debited ~loc:__LOC__ (I i) unregistered credit fee - -(** contracts not registered as delegate can delete their delegation *) -let delegate_can_be_removed_from_unregistered_contract~fee () = - Context.init 1 >>=? fun (b, bootstrap_contracts) -> - let bootstrap = List.hd bootstrap_contracts in - let unregistered_account = Account.new_account () in - let unregistered_pkh = Account.(unregistered_account.pkh) in - let unregistered = Contract.implicit_contract unregistered_pkh in - Incremental.begin_construction b >>=? fun i -> - Context.Contract.manager (I i) bootstrap >>=? fun manager -> - let credit = Tez.of_int 10 in - Op.transaction ~fee:Tez.zero (I i) bootstrap unregistered credit >>=? fun credit_contract -> - Context.Contract.balance (I i) bootstrap >>=? fun balance -> - Incremental.add_operation i credit_contract >>=? fun i -> - (* delegate to bootstrap *) - Op.delegation ~fee:Tez.zero (I i) unregistered (Some manager.pkh) >>=? fun set_delegate -> - Incremental.add_operation i set_delegate >>=? fun i -> - Context.Contract.delegate (I i) unregistered >>=? fun delegate -> - Assert.equal_pkh ~loc:__LOC__ delegate manager.pkh >>=? fun () -> - (* remove delegation *) - Op.delegation ~fee (I i) unregistered None >>=? fun delete_delegate -> - if fee > balance then - Incremental.add_operation i delete_delegate >>= fun err -> - Assert.proto_error ~loc:__LOC__ err (function - | Contract_storage.Balance_too_low _ -> true - | _ -> false) - else - Incremental.add_operation i delete_delegate >>=? fun i -> - (* the delegate has been removed *) - (Context.Contract.delegate_opt (I i) unregistered >>=? function - | None -> return_unit - | Some _ -> failwith "Expected delegate to be removed") - >>=? fun () -> - (* fee has been debited *) - Assert.balance_was_debited ~loc:__LOC__ (I i) unregistered credit fee - -(** bootstrap keys are already registered as delegate keys *) -let bootstrap_manager_already_registered_delegate ~fee () = - Context.init 1 >>=? fun (b, bootstrap_contracts) -> - Incremental.begin_construction b >>=? fun i -> - let bootstrap = List.hd bootstrap_contracts in - Context.Contract.manager (I i) bootstrap >>=? fun manager -> - let pkh = manager.pkh in - let impl_contract = Contract.implicit_contract pkh in - Context.Contract.balance (I i) impl_contract >>=? fun balance -> - Op.delegation ~fee (I i) impl_contract (Some pkh) >>=? fun sec_reg -> - if fee > balance then - begin - Incremental.add_operation i sec_reg >>= fun err -> - Assert.proto_error ~loc:__LOC__ err (function - | Contract_storage.Balance_too_low _ -> true - | _ -> false) - end - else - begin - Incremental.add_operation ~expect_failure:(function - | Environment.Ecoproto_error Delegate_storage.Active_delegate :: _ -> - return_unit - | _ -> - failwith "Delegate is already active and operation should fail.") - i sec_reg >>=? fun i -> - (* fee has been debited *) - Assert.balance_was_debited ~loc:__LOC__ (I i) impl_contract balance fee - end - -(** bootstrap manager can be set as delegate of an originated contract - (through origination operation) *) -let delegate_to_bootstrap_by_origination ~fee () = - Context.init 1 >>=? fun (b, bootstrap_contracts) -> - Incremental.begin_construction b >>=? fun i -> - let bootstrap = List.hd bootstrap_contracts in - Context.Contract.manager (I i) bootstrap >>=? fun manager -> - Context.Contract.balance (I i) bootstrap >>=? fun balance -> - (* originate a contract with bootstrap's manager as delegate *) - Op.origination ~fee ~credit:Tez.zero ~delegate:manager.pkh (I i) bootstrap ~script:Op.dummy_script >>=? fun (op, orig_contract) -> - Context.get_constants (I i) >>=? fun { parametric = { origination_size ; cost_per_byte ; _ }; _ } -> (* 0.257tz *) - Tez.(cost_per_byte *? Int64.of_int origination_size) >>?= fun origination_burn -> - Lwt.return ( - Tez.(+?) fee origination_burn >>? - Tez.(+?) Op.dummy_script_cost) >>=? fun total_fee -> - if fee > balance then - begin - Incremental.add_operation i op >>= fun err -> - Assert.proto_error ~loc:__LOC__ err (function - | Contract_storage.Balance_too_low _ -> true - | _ -> false) - end - else if total_fee > balance && balance >= fee then - (* origination did not proceed; fee has been debited *) - begin - Incremental.add_operation i ~expect_failure:(function - | Environment.Ecoproto_error Contract.Balance_too_low _ :: _ -> - return_unit - | _ -> - failwith "Not enough balance for origination burn: operation should fail.") - op >>=? fun i -> - (* fee was taken *) - Assert.balance_was_debited ~loc:__LOC__ (I i) bootstrap balance fee >>=? fun () -> - (* originated contract has not been created *) - Context.Contract.balance (I i) orig_contract >>= fun err -> - Assert.error ~loc:__LOC__ err (function - | RPC_context.Not_found _ -> true - | _ -> false) - end - else - (* bootstrap is delegate, fee + origination burn have been debited *) - begin - Incremental.add_operation i op >>=? fun i -> - Context.Contract.delegate (I i) orig_contract >>=? fun delegate -> - Assert.equal_pkh ~loc:__LOC__ delegate manager.pkh >>=? fun () -> - Assert.balance_was_debited ~loc:__LOC__ (I i) bootstrap balance total_fee - end - -let tests_bootstrap_contracts = [ - Test.tztest "bootstrap contracts delegate to themselves" `Quick bootstrap_manager_is_bootstrap_delegate ; - Test.tztest "bootstrap contracts can change their delegate (small fee)" `Quick (bootstrap_delegate_cannot_change ~fee:Tez.one_mutez) ; - Test.tztest "bootstrap contracts can change their delegate (max fee)" `Quick (bootstrap_delegate_cannot_change ~fee:Tez.max_tez) ; - Test.tztest "bootstrap contracts cannot remove their delegation (small fee)" `Quick (bootstrap_delegate_cannot_be_removed ~fee:Tez.one_mutez) ; - Test.tztest "bootstrap contracts cannot remove their delegation (max fee)" `Quick (bootstrap_delegate_cannot_be_removed ~fee:Tez.max_tez) ; - Test.tztest "contracts not registered as delegate can remove their delegation (small fee)" `Quick (delegate_can_be_changed_from_unregistered_contract ~fee:Tez.one_mutez) ; - Test.tztest "contracts not registered as delegate can remove their delegation (max fee)" `Quick (delegate_can_be_changed_from_unregistered_contract ~fee:Tez.max_tez) ; - Test.tztest "contracts not registered as delegate can remove their delegation (small fee)" `Quick (delegate_can_be_removed_from_unregistered_contract ~fee:Tez.one_mutez) ; - Test.tztest "contracts not registered as delegate can remove their delegation (max fee)" `Quick (delegate_can_be_removed_from_unregistered_contract ~fee:Tez.max_tez) ; - Test.tztest "bootstrap keys are already registered as delegate keys (small fee)" `Quick (bootstrap_manager_already_registered_delegate ~fee:Tez.one_mutez) ; - Test.tztest "bootstrap keys are already registered as delegate keys (max fee)" `Quick (bootstrap_manager_already_registered_delegate ~fee:Tez.max_tez) ; - Test.tztest "bootstrap manager can be delegate (init origination, small fee)" `Quick (delegate_to_bootstrap_by_origination ~fee:Tez.one_mutez) ; - (* balance enough for fee but not for fee + origination burn + dummy script storage cost *) - Test.tztest "bootstrap manager can be delegate (init origination, edge case)" `Quick (delegate_to_bootstrap_by_origination ~fee:(Tez.of_mutez_exn 3_999_999_705_000L)) ; - (* fee bigger than bootstrap's initial balance*) - Test.tztest "bootstrap manager can be delegate (init origination, large fee)" `Quick (delegate_to_bootstrap_by_origination ~fee:(Tez.of_int 10_000_000)) ; -] - -(**************************************************************************) -(* delegate registration *) -(**************************************************************************) -(* A delegate is a pkh. Delegates must be registered. Registration is - done via the self-delegation of the implicit contract corresponding - to the pkh. The implicit contract must be credited when the - self-delegation is done. Furthermore, trying to register an already - registered key raises an error. - - In this series of tests, we verify that - 1- unregistered delegate keys cannot be delegated to, - 2- registered keys can be delegated to, - 3- registering an already registered key raises an error. - - - We consider three scenarios for setting a delegate: - - through origination, - - through delegation when the implicit contract has no delegate yet, - - through delegation when the implicit contract already has a delegate. - - We also test that emptying the implicit contract linked to a - registered delegate key does not unregister the delegate key. -*) - -(* - Valid registration - - Unregistered key: - - contract not credited and no self-delegation - - contract credited but no self-delegation - - contract not credited and self-delegation - -Not credited: -- no credit operation -- credit operation of 1μꜩ and then debit operation of 1μꜩ - -*) - -(** A- unregistered delegate keys cannot be used for delegation *) - -(* Two main series of tests: without self-delegation, and with a failed attempt at self-delegation - 1- no self-delegation - a- no credit - - no token transfer - - credit of 1μꜩ and then debit of 1μꜩ - b- with credit of 1μꜩ. - For every scenario, we try three different ways of delegating: - - through origination (init origination) - - through delegation when no delegate was assigned (init delegation) - - through delegation when a delegate was assigned (switch delegation). - - 2- Self-delegation fails if the contract has no credit. We try the - two possibilities of 1a for non-credited contracts. -*) - -let expect_unregistered_key pkh = function - | Environment.Ecoproto_error Roll_storage.Unregistered_delegate pkh0 :: _ - when pkh = pkh0 -> return_unit - | _ -> failwith "Delegate key is not registered: operation should fail." - -(* A1: no self-delegation *) -(* no token transfer, no self-delegation *) -let unregistered_delegate_key_init_origination ~fee () = - Context.init 1 >>=? fun (b, bootstrap_contracts) -> - Incremental.begin_construction b >>=? fun i -> - let bootstrap = List.hd bootstrap_contracts in - let unregistered_account = Account.new_account () in - let unregistered_pkh = Account.(unregistered_account.pkh) in - (* origination with delegate argument *) - Op.origination ~fee ~delegate:unregistered_pkh (I i) bootstrap ~script:Op.dummy_script >>=? fun (op, orig_contract) -> - Context.get_constants (I i) >>=? fun { parametric = { origination_size ; cost_per_byte ; _ }; _ } -> - Tez.(cost_per_byte *? Int64.of_int origination_size) >>?= fun origination_burn -> - Lwt.return (Tez.(+?) fee origination_burn) >>=? fun _total_fee -> (* FIXME unused variable *) - Context.Contract.balance (I i) bootstrap >>=? fun balance -> - if fee > balance then - begin - Incremental.add_operation i op >>= fun err -> - Assert.proto_error ~loc:__LOC__ err (function - | Contract_storage.Balance_too_low _ -> true - | _ -> false) - end - else - (* origination did not proceed; fee has been debited *) - begin - Incremental.add_operation - ~expect_failure:(expect_unregistered_key unregistered_pkh) - i op >>=? fun i -> - Assert.balance_was_debited ~loc:__LOC__ (I i) bootstrap balance fee >>=? fun () -> - (* originated contract has not been created *) - Context.Contract.balance (I i) orig_contract >>= fun err -> - Assert.error ~loc:__LOC__ err (function - | RPC_context.Not_found _ -> true - | _ -> false) - end - -let unregistered_delegate_key_init_delegation ~fee () = - Context.init 1 >>=? fun (b, bootstrap_contracts) -> - Incremental.begin_construction b >>=? fun i -> - let bootstrap = List.hd bootstrap_contracts in - let unregistered_account = Account.new_account () in - let unregistered_pkh = Account.(unregistered_account.pkh) in - let impl_contract = Contract.implicit_contract unregistered_pkh in - let unregistered_delegate_account = Account.new_account () in - let unregistered_delegate_pkh = Account.(unregistered_delegate_account.pkh) in - (* initial credit for the delegated contract *) - let credit = Tez.of_int 10 in - Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract credit >>=? fun credit_contract -> - Incremental.add_operation i credit_contract >>=? fun i -> - Assert.balance_is ~loc:__LOC__ (I i) impl_contract credit >>=? fun _ -> - (* try to delegate *) - Op.delegation ~fee (I i) impl_contract (Some unregistered_delegate_pkh) >>=? fun delegate_op -> - if fee > credit then - begin - Incremental.add_operation i delegate_op >>= fun err -> - Assert.proto_error ~loc:__LOC__ err (function - | Contract_storage.Balance_too_low _ -> true - | _ -> false) - end - else - (* fee has been debited; no delegate *) - begin - Incremental.add_operation i - ~expect_failure:(expect_unregistered_key unregistered_delegate_pkh) - delegate_op >>=? fun i -> - Assert.balance_was_debited ~loc:__LOC__ (I i) impl_contract credit fee >>=? fun () -> - (* implicit contract has no delegate *) - Context.Contract.delegate (I i) impl_contract >>= fun err -> - Assert.error ~loc:__LOC__ err (function - | RPC_context.Not_found _ -> true - | _ -> false) - end - -let unregistered_delegate_key_switch_delegation ~fee () = - Context.init 1 >>=? fun (b, bootstrap_contracts) -> - Incremental.begin_construction b >>=? fun i -> - let bootstrap = List.hd bootstrap_contracts in - let bootstrap_pkh = Contract.is_implicit bootstrap |> Option.unopt_assert ~loc:__POS__ in - let unregistered_account = Account.new_account () in - let unregistered_pkh = Account.(unregistered_account.pkh) in - let impl_contract = Contract.implicit_contract unregistered_pkh in - let unregistered_delegate_account = Account.new_account () in - let unregistered_delegate_pkh = Account.(unregistered_delegate_account.pkh) in - (* initial credit for the delegated contract *) - let credit = Tez.of_int 10 in - Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract credit >>=? fun init_credit -> - Incremental.add_operation i init_credit >>=? fun i -> - Assert.balance_is ~loc:__LOC__ (I i) impl_contract credit >>=? fun _ -> - (* set and check the initial delegate *) - Op.delegation ~fee:Tez.zero (I i) impl_contract (Some bootstrap_pkh) >>=? fun delegate_op -> - Incremental.add_operation i delegate_op >>=? fun i -> - Context.Contract.delegate (I i) bootstrap >>=? fun delegate_pkh -> - Assert.equal_pkh ~loc:__LOC__ bootstrap_pkh delegate_pkh >>=? fun () -> - (* try to delegate *) - Op.delegation ~fee (I i) impl_contract (Some unregistered_delegate_pkh) >>=? fun delegate_op -> - if fee > credit then - begin - Incremental.add_operation i delegate_op >>= fun err -> - Assert.proto_error ~loc:__LOC__ err (function - | Contract_storage.Balance_too_low _ -> true - | _ -> false) - end - else - (* fee has been debited; no delegate *) - begin - Incremental.add_operation i - ~expect_failure:(expect_unregistered_key unregistered_delegate_pkh) - delegate_op >>=? fun i -> - Assert.balance_was_debited ~loc:__LOC__ (I i) impl_contract credit fee >>=? fun () -> - (* implicit contract delegate has not changed *) - Context.Contract.delegate (I i) bootstrap >>=? fun delegate_pkh_after -> - Assert.equal_pkh ~loc:__LOC__ delegate_pkh delegate_pkh_after - end - -(* credit of some amount, no self-delegation *) -let unregistered_delegate_key_init_origination_credit ~fee ~amount () = - Context.init 1 >>=? fun (b, bootstrap_contracts) -> - Incremental.begin_construction b >>=? fun i -> - let bootstrap = List.hd bootstrap_contracts in - let unregistered_account = Account.new_account () in - let unregistered_pkh = Account.(unregistered_account.pkh) in - let impl_contract = Contract.implicit_contract unregistered_pkh in - (* credit + check balance *) - Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract amount >>=? fun create_contract -> - Incremental.add_operation i create_contract >>=? fun i -> - Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount >>=? fun _ -> - (* origination with delegate argument *) - Context.Contract.balance (I i) bootstrap >>=? fun balance -> - Op.origination ~fee ~delegate:unregistered_pkh (I i) bootstrap ~script:Op.dummy_script >>=? fun (op, orig_contract) -> - if fee > balance then - begin - Incremental.add_operation i op >>= fun err -> - Assert.proto_error ~loc:__LOC__ err (function - | Contract_storage.Balance_too_low _ -> true - | _ -> false) - end - else (* origination not done, fee taken *) - begin - Incremental.add_operation - ~expect_failure:(expect_unregistered_key unregistered_pkh) - i op >>=? fun i -> - Assert.balance_was_debited ~loc:__LOC__ (I i) bootstrap balance fee >>=? fun () -> - Context.Contract.balance (I i) orig_contract >>= fun err -> - Assert.error ~loc:__LOC__ err (function - | RPC_context.Not_found _ -> true - | _ -> false) - end - -let unregistered_delegate_key_init_delegation_credit ~fee ~amount () = - Context.init 1 >>=? fun (b, bootstrap_contracts) -> - Incremental.begin_construction b >>=? fun i -> - let bootstrap = List.hd bootstrap_contracts in - let unregistered_account = Account.new_account () in - let unregistered_pkh = Account.(unregistered_account.pkh) in - let impl_contract = Contract.implicit_contract unregistered_pkh in - let unregistered_delegate_account = Account.new_account () in - let unregistered_delegate_pkh = Account.(unregistered_delegate_account.pkh) in - (* credit + check balance *) - Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract amount >>=? fun create_contract -> - Incremental.add_operation i create_contract >>=? fun i -> - Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount >>=? fun _ -> - (* initial credit for the delegated contract *) - let credit = Tez.of_int 10 in - Lwt.return Tez.(credit +? amount) >>=? fun balance -> - Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract credit >>=? fun init_credit -> - Incremental.add_operation i init_credit >>=? fun i -> - Assert.balance_is ~loc:__LOC__ (I i) impl_contract balance >>=? fun _ -> - (* try to delegate *) - Op.delegation ~fee (I i) impl_contract (Some unregistered_delegate_pkh) >>=? fun delegate_op -> - if fee > credit then - Incremental.add_operation i delegate_op >>= fun err -> - Assert.proto_error ~loc:__LOC__ err (function - | Contract_storage.Balance_too_low _ -> true - | _ -> false) - else - begin - (* fee has been taken, no delegate for contract *) - Incremental.add_operation - ~expect_failure:(expect_unregistered_key unregistered_delegate_pkh) - i delegate_op >>=? fun i -> - Assert.balance_was_debited ~loc:__LOC__ (I i) impl_contract balance fee >>=? fun () -> - Context.Contract.delegate (I i) impl_contract >>= fun err -> - - Assert.error ~loc:__LOC__ err (function - | RPC_context.Not_found _ -> true - | _ -> false) - end - -let unregistered_delegate_key_switch_delegation_credit ~fee ~amount () = - Context.init 1 >>=? fun (b, bootstrap_contracts) -> - Incremental.begin_construction b >>=? fun i -> - let bootstrap = List.hd bootstrap_contracts in - let bootstrap_pkh = Contract.is_implicit bootstrap |> Option.unopt_assert ~loc:__POS__ in - let unregistered_account = Account.new_account () in - let unregistered_pkh = Account.(unregistered_account.pkh) in - let impl_contract = Contract.implicit_contract unregistered_pkh in - let unregistered_delegate_account = Account.new_account () in - let unregistered_delegate_pkh = Account.(unregistered_delegate_account.pkh) in - (* credit + check balance *) - Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract amount >>=? fun create_contract -> - Incremental.add_operation i create_contract >>=? fun i -> - Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount >>=? fun _ -> - (* initial credit for the delegated contract *) - let credit = Tez.of_int 10 in - Lwt.return Tez.(credit +? amount) >>=? fun balance -> - Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract credit >>=? fun init_credit -> - Incremental.add_operation i init_credit >>=? fun i -> - Assert.balance_is ~loc:__LOC__ (I i) impl_contract balance >>=? fun _ -> - (* set and check the initial delegate *) - Op.delegation ~fee:Tez.zero (I i) impl_contract (Some bootstrap_pkh) >>=? fun delegate_op -> - Incremental.add_operation i delegate_op >>=? fun i -> - Context.Contract.delegate (I i) bootstrap >>=? fun delegate_pkh -> - Assert.equal_pkh ~loc:__LOC__ bootstrap_pkh delegate_pkh >>=? fun () -> - (* switch delegate through delegation *) - Op.delegation ~fee (I i) impl_contract (Some unregistered_delegate_pkh) >>=? fun delegate_op -> - if fee > credit then - Incremental.add_operation i delegate_op >>= fun err -> - Assert.proto_error ~loc:__LOC__ err (function - | Contract_storage.Balance_too_low _ -> true - | _ -> false) - else - begin - (* fee has been taken, delegate for contract has not changed *) - Incremental.add_operation - ~expect_failure:(expect_unregistered_key unregistered_delegate_pkh) - i delegate_op >>=? fun i -> - Assert.balance_was_debited ~loc:__LOC__ (I i) impl_contract balance fee >>=? fun () -> - Context.Contract.delegate (I i) impl_contract >>=? fun delegate -> - Assert.not_equal_pkh ~loc:__LOC__ delegate unregistered_delegate_pkh >>=? fun () -> - Assert.equal_pkh ~loc:__LOC__ delegate bootstrap_pkh - end - -(* a credit of some amount followed by a debit of the same amount, no self-delegation *) -let unregistered_delegate_key_init_origination_credit_debit ~fee ~amount () = - Context.init 1 >>=? fun (b, bootstrap_contracts) -> - Incremental.begin_construction b >>=? fun i -> - let bootstrap = List.hd bootstrap_contracts in - let unregistered_account = Account.new_account () in - let unregistered_pkh = Account.(unregistered_account.pkh) in - let impl_contract = Contract.implicit_contract unregistered_pkh in - (* credit + check balance *) - Op.transaction (I i) bootstrap impl_contract amount >>=? fun create_contract -> - Incremental.add_operation i create_contract >>=? fun i -> - Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount >>=? fun _ -> - (* debit + check balance *) - Op.transaction (I i) impl_contract bootstrap amount >>=? fun debit_contract -> - Incremental.add_operation i debit_contract >>=? fun i -> - Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero >>=? fun _ -> - (* origination with delegate argument *) - Context.Contract.balance (I i) bootstrap >>=? fun balance -> - Op.origination ~fee ~delegate:unregistered_pkh (I i) bootstrap ~script:Op.dummy_script >>=? fun (op, orig_contract) -> - if fee > balance then - begin - Incremental.add_operation i op >>= fun err -> - Assert.proto_error ~loc:__LOC__ err (function - | Contract_storage.Balance_too_low _ -> true - | _ -> false) - end - else (* fee taken, origination not processed *) - begin - Incremental.add_operation - ~expect_failure:(expect_unregistered_key unregistered_pkh) - i op >>=? fun i -> - Assert.balance_was_debited ~loc:__LOC__ (I i) bootstrap balance fee >>=? fun () -> - Context.Contract.balance (I i) orig_contract >>= fun err -> - Assert.error ~loc:__LOC__ err (function - | RPC_context.Not_found _ -> true - | _ -> false) - end - -let unregistered_delegate_key_init_delegation_credit_debit ~amount ~fee () = - Context.init 1 >>=? fun (b, bootstrap_contracts) -> - Incremental.begin_construction b >>=? fun i -> - let bootstrap = List.hd bootstrap_contracts in - let unregistered_account = Account.new_account () in - let unregistered_pkh = Account.(unregistered_account.pkh) in - let impl_contract = Contract.implicit_contract unregistered_pkh in - let unregistered_delegate_account = Account.new_account () in - let unregistered_delegate_pkh = Account.(unregistered_delegate_account.pkh) in - (* credit + check balance *) - Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract amount >>=? fun create_contract -> - Incremental.add_operation i create_contract >>=? fun i -> - Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount >>=? fun _ -> - (* debit + check balance *) - Op.transaction ~fee:Tez.zero (I i) impl_contract bootstrap amount >>=? fun debit_contract -> - Incremental.add_operation i debit_contract >>=? fun i -> - Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero >>=? fun _ -> - (* initial credit for the delegated contract *) - let credit = Tez.of_int 10 in - Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract credit >>=? fun credit_contract -> - Incremental.add_operation i credit_contract >>=? fun i -> - Assert.balance_is ~loc:__LOC__ (I i) impl_contract credit >>=? fun _ -> - (* try to delegate *) - Op.delegation ~fee (I i) impl_contract (Some unregistered_delegate_pkh) >>=? fun delegate_op -> - - if fee > credit then - begin - Incremental.add_operation i delegate_op >>= fun err -> - Assert.proto_error ~loc:__LOC__ err (function - | Contract_storage.Balance_too_low _ -> true - | _ -> false) - end - else - begin - (* fee has been taken, no delegate for contract *) - Incremental.add_operation - ~expect_failure:(expect_unregistered_key unregistered_delegate_pkh) - i delegate_op >>=? fun i -> - Assert.balance_was_debited ~loc:__LOC__ (I i) impl_contract credit fee >>=? fun () -> - Context.Contract.delegate (I i) impl_contract >>= fun err -> - - Assert.error ~loc:__LOC__ err (function - | RPC_context.Not_found _ -> true - | _ -> false) - end - -let unregistered_delegate_key_switch_delegation_credit_debit ~fee ~amount () = - Context.init 1 >>=? fun (b, bootstrap_contracts) -> - Incremental.begin_construction b >>=? fun i -> - let bootstrap = List.hd bootstrap_contracts in - let bootstrap_pkh = Contract.is_implicit bootstrap |> Option.unopt_assert ~loc:__POS__ in - let unregistered_account = Account.new_account () in - let unregistered_pkh = Account.(unregistered_account.pkh) in - let impl_contract = Contract.implicit_contract unregistered_pkh in - let unregistered_delegate_account = Account.new_account () in - let unregistered_delegate_pkh = Account.(unregistered_delegate_account.pkh) in - (* credit + check balance *) - Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract amount >>=? fun create_contract -> - Incremental.add_operation i create_contract >>=? fun i -> - Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount >>=? fun _ -> - (* debit + check balance *) - Op.transaction (I i) impl_contract bootstrap amount >>=? fun debit_contract -> - Incremental.add_operation i debit_contract >>=? fun i -> - Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero >>=? fun _ -> - (* delegation - initial credit for the delegated contract *) - let credit = Tez.of_int 10 in - Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract credit >>=? fun credit_contract -> - Incremental.add_operation i credit_contract >>=? fun i -> - Assert.balance_is ~loc:__LOC__ (I i) impl_contract credit >>=? fun _ -> - (* set and check the initial delegate *) - Op.delegation ~fee:Tez.zero (I i) impl_contract (Some bootstrap_pkh) >>=? fun delegate_op -> - Incremental.add_operation i delegate_op >>=? fun i -> - Context.Contract.delegate (I i) bootstrap >>=? fun delegate_pkh -> - Assert.equal_pkh ~loc:__LOC__ bootstrap_pkh delegate_pkh >>=? fun () -> - (* switch delegate through delegation *) - Op.delegation (I i) ~fee impl_contract (Some unregistered_delegate_pkh) >>=? fun delegate_op -> - - if fee > credit then - Incremental.add_operation i delegate_op >>= fun err -> - Assert.proto_error ~loc:__LOC__ err (function - | Contract_storage.Balance_too_low _ -> true - | _ -> false) - else - begin - (* fee has been taken, delegate for contract has not changed *) - Incremental.add_operation - ~expect_failure:(expect_unregistered_key unregistered_delegate_pkh) - i delegate_op >>=? fun i -> - Assert.balance_was_debited ~loc:__LOC__ (I i) impl_contract credit fee >>=? fun () -> - Context.Contract.delegate (I i) impl_contract >>=? fun delegate -> - Assert.not_equal_pkh ~loc:__LOC__ delegate unregistered_delegate_pkh - end - -(* A2- self-delegation to an empty contract fails *) -let failed_self_delegation_no_transaction () = - Context.init 1 >>=? fun (b, _) -> - Incremental.begin_construction b >>=? fun i -> - let account = Account.new_account () in - let unregistered_pkh = Account.(account.pkh) in - let impl_contract = Contract.implicit_contract unregistered_pkh in - (* check balance *) - Context.Contract.balance (I i) impl_contract >>=? fun balance -> - Assert.equal_tez ~loc:__LOC__ Tez.zero balance >>=? fun _ -> - (* self delegation fails *) - Op.delegation (I i) impl_contract (Some unregistered_pkh) >>=? fun self_delegation -> - Incremental.add_operation i self_delegation >>= fun err -> - Assert.proto_error ~loc:__LOC__ err (function - | Contract_storage.Empty_implicit_contract pkh -> - if pkh = unregistered_pkh then true else false - | _ -> false) - -let failed_self_delegation_emptied_implicit_contract amount () = - (* create an implicit contract *) - Context.init 1 >>=? fun (b, bootstrap_contracts) -> - Incremental.begin_construction b >>=? fun i -> - let bootstrap = List.hd bootstrap_contracts in - let account = Account.new_account () in - let unregistered_pkh = Account.(account.pkh) in - let impl_contract = Contract.implicit_contract unregistered_pkh in - (* credit implicit contract and check balance *) - Op.transaction (I i) bootstrap impl_contract amount >>=? fun create_contract -> - Incremental.add_operation i create_contract >>=? fun i -> - Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount >>=? fun _ -> - (* empty implicit contract and check balance *) - Op.transaction (I i) impl_contract bootstrap amount >>=? fun create_contract -> - Incremental.add_operation i create_contract >>=? fun i -> - Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero >>=? fun _ -> - (* self delegation fails *) - Op.delegation (I i) impl_contract (Some unregistered_pkh) >>=? fun self_delegation -> - Incremental.add_operation i self_delegation >>= fun err -> - Assert.proto_error ~loc:__LOC__ err (function - | Contract_storage.Empty_implicit_contract pkh -> - if pkh = unregistered_pkh then true else false - | _ -> false) - -(** B- valid registration: - - credit implicit contract with some ꜩ + verification of balance - - self delegation + verification - - empty contract + verification of balance + verification of not being erased / self-delegation - - create delegator implicit contract w first implicit contract as delegate + verification of delegation *) -let valid_delegate_registration_init_delegation_credit amount () = - (* create an implicit contract *) - Context.init 1 >>=? fun (b, bootstrap_contracts) -> - Incremental.begin_construction b >>=? fun i -> - let bootstrap = List.hd bootstrap_contracts in - let delegate_account = Account.new_account () in - let delegate_pkh = Account.(delegate_account.pkh) in - let impl_contract = Contract.implicit_contract delegate_pkh in - (* credit > 0ꜩ + check balance *) - Op.transaction (I i) bootstrap impl_contract amount >>=? fun create_contract -> - Incremental.add_operation i create_contract >>=? fun i -> - Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount >>=? fun _ -> - (* self delegation + verification *) - Op.delegation (I i) impl_contract (Some delegate_pkh) >>=? fun self_delegation -> - Incremental.add_operation i self_delegation >>=? fun i -> - Context.Contract.delegate (I i) impl_contract >>=? fun delegate -> - Assert.equal_pkh ~loc:__LOC__ delegate delegate_pkh >>=? fun _ -> - (* create an implicit contract with no delegate *) - let unregistered_account = Account.new_account () in - let unregistered_pkh = Account.(unregistered_account.pkh) in - let delegator = Contract.implicit_contract unregistered_pkh in - Op.transaction ~fee:Tez.zero (I i) bootstrap delegator Tez.one >>=? fun credit_contract -> - Incremental.add_operation i credit_contract >>=? fun i -> - (* check no delegate for delegator contract *) - Context.Contract.delegate (I i) delegator >>= fun err -> - Assert.error ~loc:__LOC__ err (function - | RPC_context.Not_found _ -> true - | _ -> false) >>=? fun _ -> - (* delegation to the newly registered key *) - Op.delegation (I i) delegator (Some delegate_account.pkh) >>=? fun delegation -> - Incremental.add_operation i delegation >>=? fun i -> - (* check delegation *) - Context.Contract.delegate (I i) delegator >>=? fun delegator_delegate -> - Assert.equal_pkh ~loc:__LOC__ delegator_delegate delegate_pkh - -let valid_delegate_registration_switch_delegation_credit amount () = - (* create an implicit contract *) - Context.init 1 >>=? fun (b, bootstrap_contracts) -> - Incremental.begin_construction b >>=? fun i -> - let bootstrap = List.hd bootstrap_contracts in - let delegate_account = Account.new_account () in - let delegate_pkh = Account.(delegate_account.pkh) in - let impl_contract = Contract.implicit_contract delegate_pkh in - (* credit > 0ꜩ + check balance *) - Op.transaction (I i) bootstrap impl_contract amount >>=? fun create_contract -> - Incremental.add_operation i create_contract >>=? fun i -> - Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount >>=? fun _ -> - (* self delegation + verification *) - Op.delegation (I i) impl_contract (Some delegate_pkh) >>=? fun self_delegation -> - Incremental.add_operation i self_delegation >>=? fun i -> - Context.Contract.delegate (I i) impl_contract >>=? fun delegate -> - Assert.equal_pkh ~loc:__LOC__ delegate delegate_pkh >>=? fun _ -> - (* create an implicit contract with bootstrap's account as delegate *) - let unregistered_account = Account.new_account () in - let unregistered_pkh = Account.(unregistered_account.pkh) in - let delegator = Contract.implicit_contract unregistered_pkh in - Op.transaction ~fee:Tez.zero (I i) bootstrap delegator Tez.one >>=? fun credit_contract -> - Incremental.add_operation i credit_contract >>=? fun i -> - Context.Contract.manager (I i) bootstrap >>=? fun bootstrap_manager -> - Op.delegation (I i) delegator (Some bootstrap_manager.pkh) >>=? fun delegation -> - Incremental.add_operation i delegation >>=? fun i -> - (* test delegate of new contract is bootstrap *) - Context.Contract.delegate (I i) delegator >>=? fun delegator_delegate -> - Assert.equal_pkh ~loc:__LOC__ delegator_delegate bootstrap_manager.pkh >>=? fun _ -> - (* delegation with newly registered key *) - Op.delegation (I i) delegator (Some delegate_account.pkh) >>=? fun delegation -> - Incremental.add_operation i delegation >>=? fun i -> - Context.Contract.delegate (I i) delegator >>=? fun delegator_delegate -> - Assert.equal_pkh ~loc:__LOC__ delegator_delegate delegate_pkh - -let valid_delegate_registration_init_delegation_credit_debit amount () = - (* create an implicit contract *) - Context.init 1 >>=? fun (b, bootstrap_contracts) -> - Incremental.begin_construction b >>=? fun i -> - let bootstrap = List.hd bootstrap_contracts in - let delegate_account = Account.new_account () in - let delegate_pkh = Account.(delegate_account.pkh) in - let impl_contract = Contract.implicit_contract delegate_pkh in - (* credit > 0ꜩ+ check balance *) - Op.transaction (I i) bootstrap impl_contract amount >>=? fun create_contract -> - Incremental.add_operation i create_contract >>=? fun i -> - Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount >>=? fun _ -> - (* self delegation + verification *) - Op.delegation (I i) impl_contract (Some delegate_pkh) >>=? fun self_delegation -> - Incremental.add_operation i self_delegation >>=? fun i -> - Context.Contract.delegate (I i) impl_contract >>=? fun delegate -> - Assert.equal_pkh ~loc:__LOC__ delegate_pkh delegate >>=? fun _ -> - (* empty implicit contracts are usually deleted but they are kept if - they were registered as delegates. we empty the contract in - order to verify this. *) - Op.transaction (I i) impl_contract bootstrap amount >>=? fun empty_contract -> - Incremental.add_operation i empty_contract >>=? fun i -> - (* impl_contract is empty *) - Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero >>=? fun _ -> - (* verify self-delegation after contract is emptied *) - Context.Contract.delegate (I i) impl_contract >>=? fun delegate -> - Assert.equal_pkh ~loc:__LOC__ delegate_pkh delegate >>=? fun _ -> - (* create an implicit contract with no delegate *) - let unregistered_account = Account.new_account () in - let unregistered_pkh = Account.(unregistered_account.pkh) in - let delegator = Contract.implicit_contract unregistered_pkh in - Op.transaction ~fee:Tez.zero (I i) bootstrap delegator Tez.one >>=? fun credit_contract -> - Incremental.add_operation i credit_contract >>=? fun i -> - (* check no delegate for delegator contract *) - Context.Contract.delegate (I i) delegator >>= fun err -> - Assert.error ~loc:__LOC__ err (function - | RPC_context.Not_found _ -> true - | _ -> false) >>=? fun _ -> - (* delegation to the newly registered key *) - Op.delegation (I i) delegator (Some delegate_account.pkh) >>=? fun delegation -> - Incremental.add_operation i delegation >>=? fun i -> - (* check delegation *) - Context.Contract.delegate (I i) delegator >>=? fun delegator_delegate -> - Assert.equal_pkh ~loc:__LOC__ delegator_delegate delegate_pkh - -let valid_delegate_registration_switch_delegation_credit_debit amount () = - (* create an implicit contract *) - Context.init 1 >>=? fun (b, bootstrap_contracts) -> - Incremental.begin_construction b >>=? fun i -> - let bootstrap = List.hd bootstrap_contracts in - let delegate_account = Account.new_account () in - let delegate_pkh = Account.(delegate_account.pkh) in - let impl_contract = Contract.implicit_contract delegate_pkh in - (* credit > 0ꜩ + check balance *) - Op.transaction (I i) bootstrap impl_contract amount >>=? fun create_contract -> - Incremental.add_operation i create_contract >>=? fun i -> - Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount >>=? fun _ -> - (* self delegation + verification *) - Op.delegation (I i) impl_contract (Some delegate_pkh) >>=? fun self_delegation -> - Incremental.add_operation i self_delegation >>=? fun i -> - Context.Contract.delegate (I i) impl_contract >>=? fun delegate -> - Assert.equal_pkh ~loc:__LOC__ delegate_pkh delegate >>=? fun _ -> - (* empty implicit contracts are usually deleted but they are kept if - they were registered as delegates. we empty the contract in - order to verify this. *) - Op.transaction (I i) impl_contract bootstrap amount >>=? fun empty_contract -> - Incremental.add_operation i empty_contract >>=? fun i -> - (* impl_contract is empty *) - Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero >>=? fun _ -> - (* create an implicit contract with bootstrap's account as delegate *) - let unregistered_account = Account.new_account () in - let unregistered_pkh = Account.(unregistered_account.pkh) in - let delegator = Contract.implicit_contract unregistered_pkh in - Op.transaction ~fee:Tez.zero (I i) bootstrap delegator Tez.one >>=? fun credit_contract -> - Incremental.add_operation i credit_contract >>=? fun i -> - Context.Contract.manager (I i) bootstrap >>=? fun bootstrap_manager -> - Op.delegation (I i) delegator (Some bootstrap_manager.pkh) >>=? fun delegation -> - Incremental.add_operation i delegation >>=? fun i -> - (* test delegate of new contract is bootstrap *) - Context.Contract.delegate (I i) delegator >>=? fun delegator_delegate -> - Assert.equal_pkh ~loc:__LOC__ delegator_delegate bootstrap_manager.pkh >>=? fun _ -> - (* delegation with newly registered key *) - Op.delegation (I i) delegator (Some delegate_account.pkh) >>=? fun delegation -> - Incremental.add_operation i delegation >>=? fun i -> - Context.Contract.delegate (I i) delegator >>=? fun delegator_delegate -> - Assert.equal_pkh ~loc:__LOC__ delegator_delegate delegate_pkh - -(** C- a second self-delegation should raise an `Active_delegate` error *) -(* with implicit contract with some credit *) -let double_registration () = - Context.init 1 >>=? fun (b, bootstrap_contracts) -> - Incremental.begin_construction b >>=? fun i -> - let bootstrap = List.hd bootstrap_contracts in - let account = Account.new_account () in - let pkh = Account.(account.pkh) in - let impl_contract = Contract.implicit_contract pkh in - (* credit 1μꜩ+ check balance *) - Op.transaction (I i) bootstrap impl_contract (Tez.one_mutez) >>=? fun create_contract -> - Incremental.add_operation i create_contract >>=? fun i -> - Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.one_mutez >>=? fun _ -> - (* self-delegation *) - Op.delegation (I i) impl_contract (Some pkh) >>=? fun self_delegation -> - Incremental.add_operation i self_delegation >>=? fun i -> - (* second self-delegation *) - Op.delegation (I i) impl_contract (Some pkh) >>=? fun second_registration -> - Incremental.add_operation i second_registration >>= fun err -> - - Assert.proto_error ~loc:__LOC__ err (function - | Delegate_storage.Active_delegate -> true - | _ -> false) - -(* with implicit contract emptied after first self-delegation *) -let double_registration_when_empty () = - Context.init 1 >>=? fun (b, bootstrap_contracts) -> - Incremental.begin_construction b >>=? fun i -> - let bootstrap = List.hd bootstrap_contracts in - let account = Account.new_account () in - let pkh = Account.(account.pkh) in - let impl_contract = Contract.implicit_contract pkh in - (* credit 1μꜩ+ check balance *) - Op.transaction (I i) bootstrap impl_contract Tez.one_mutez >>=? fun create_contract -> - Incremental.add_operation i create_contract >>=? fun i -> - Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.one_mutez >>=? fun _ -> - (* self delegation *) - Op.delegation (I i) impl_contract (Some pkh) >>=? fun self_delegation -> - Incremental.add_operation i self_delegation >>=? fun i -> - (* empty the delegate account *) - Op.transaction (I i) impl_contract bootstrap Tez.one_mutez >>=? fun empty_contract -> - Incremental.add_operation i empty_contract >>=? fun i -> - Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero >>=? fun _ -> - (* second self-delegation *) - Op.delegation (I i) impl_contract (Some pkh) >>=? fun second_registration -> - Incremental.add_operation i second_registration >>= fun err -> - - Assert.proto_error ~loc:__LOC__ err (function - | Delegate_storage.Active_delegate -> true - | _ -> false) - -(* with implicit contract emptied then recredited after first self-delegation *) -let double_registration_when_recredited () = - Context.init 1 >>=? fun (b, bootstrap_contracts) -> - Incremental.begin_construction b >>=? fun i -> - let bootstrap = List.hd bootstrap_contracts in - let account = Account.new_account () in - let pkh = Account.(account.pkh) in - let impl_contract = Contract.implicit_contract pkh in - (* credit 1μꜩ+ check balance *) - Op.transaction (I i) bootstrap impl_contract Tez.one_mutez >>=? fun create_contract -> - Incremental.add_operation i create_contract >>=? fun i -> - Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.one_mutez >>=? fun _ -> - (* self delegation *) - Op.delegation (I i) impl_contract (Some pkh) >>=? fun self_delegation -> - Incremental.add_operation i self_delegation >>=? fun i -> - (* empty the delegate account *) - Op.transaction (I i) impl_contract bootstrap Tez.one_mutez >>=? fun empty_contract -> - Incremental.add_operation i empty_contract >>=? fun i -> - Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero >>=? fun _ -> - (* credit 1μꜩ+ check balance *) - Op.transaction (I i) bootstrap impl_contract Tez.one_mutez >>=? fun create_contract -> - Incremental.add_operation i create_contract >>=? fun i -> - Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.one_mutez >>=? fun _ -> - (* second self-delegation *) - Op.delegation (I i) impl_contract (Some pkh) >>=? fun second_registration -> - Incremental.add_operation i second_registration >>= fun err -> - - Assert.proto_error ~loc:__LOC__ err (function - | Delegate_storage.Active_delegate -> true - | _ -> false) - -(* self-delegation on unrevealed contract *) -let unregistered_and_unrevealed_self_delegate_key_init_delegation ~fee () = - Context.init 1 >>=? fun (b, bootstrap_contracts) -> - Incremental.begin_construction b >>=? fun i -> - let bootstrap = List.hd bootstrap_contracts in - let { Account.pkh ; _ } = Account.new_account () in - let { Account.pkh = delegate_pkh ; _ } = Account.new_account () in - let contract = Alpha_context.Contract.implicit_contract pkh in - Op.transaction (I i) bootstrap contract (Tez.of_int 10) >>=? fun op -> - Incremental.add_operation i op >>=? fun i -> - Op.delegation ~fee (I i) contract (Some delegate_pkh) >>=? fun op -> - Context.Contract.balance (I i) contract >>=? fun balance -> - if fee > balance then - begin - Incremental.add_operation i op >>= fun err -> - Assert.proto_error ~loc:__LOC__ err (function - | Contract_storage.Balance_too_low _ -> true - | _ -> false) - end - else - (* origination did not proceed; fee has been debited *) - begin - Incremental.add_operation - ~expect_failure:(expect_unregistered_key delegate_pkh) - i op >>=? fun i -> - Assert.balance_was_debited ~loc:__LOC__ (I i) contract balance fee - end - -(* self-delegation on revelead but not registered contract *) -let unregistered_and_revealed_self_delegate_key_init_delegation ~fee () = - Context.init 1 >>=? fun (b, bootstrap_contracts) -> - Incremental.begin_construction b >>=? fun i -> - let bootstrap = List.hd bootstrap_contracts in - let { Account.pkh ; pk ; _ } = Account.new_account () in - let { Account.pkh = delegate_pkh ; _ } = Account.new_account () in - let contract = Alpha_context.Contract.implicit_contract pkh in - Op.transaction (I i) bootstrap contract (Tez.of_int 10) >>=? fun op -> - Incremental.add_operation i op >>=? fun i -> - Op.revelation (I i) pk >>=? fun op -> - Incremental.add_operation i op >>=? fun i -> - Op.delegation ~fee (I i) contract (Some delegate_pkh) >>=? fun op -> - Context.Contract.balance (I i) contract >>=? fun balance -> - if fee > balance then - begin - Incremental.add_operation i op >>= fun err -> - Assert.proto_error ~loc:__LOC__ err (function - | Contract_storage.Balance_too_low _ -> true - | _ -> false) - end - else - (* origination did not proceed; fee has been debited *) - begin - Incremental.add_operation - ~expect_failure:(expect_unregistered_key delegate_pkh) - i op >>=? fun i -> - Assert.balance_was_debited ~loc:__LOC__ (I i) contract balance fee - end - -(* self-delegation on revealed and registered contract *) -let registered_self_delegate_key_init_delegation () = - Context.init 1 >>=? fun (b, bootstrap_contracts) -> - Incremental.begin_construction b >>=? fun i -> - let bootstrap = List.hd bootstrap_contracts in - let { Account.pkh ; _ } = Account.new_account () in - let { Account.pkh = delegate_pkh ; pk = delegate_pk ; _ } = Account.new_account () in - let contract = Alpha_context.Contract.implicit_contract pkh in - let delegate_contract = Alpha_context.Contract.implicit_contract delegate_pkh in - Op.transaction (I i) bootstrap contract (Tez.of_int 10) >>=? fun op -> - Incremental.add_operation i op >>=? fun i -> - Op.transaction (I i) bootstrap delegate_contract (Tez.of_int 1) >>=? fun op -> - Incremental.add_operation i op >>=? fun i -> - Op.revelation (I i) delegate_pk >>=? fun op -> - Incremental.add_operation i op >>=? fun i -> - Op.delegation (I i) delegate_contract (Some delegate_pkh) >>=? fun op -> - Incremental.add_operation i op >>=? fun i -> - Op.delegation(I i) contract (Some delegate_pkh) >>=? fun op -> - Incremental.add_operation i op >>=? fun i -> - Context.Contract.delegate (I i) contract >>=? fun delegate -> - Assert.equal_pkh ~loc:__LOC__ delegate delegate_pkh >>=? fun () -> - return_unit - -let tests_delegate_registration = - [ - (*** unregistered delegate key: no self-delegation ***) - (* no token transfer, no self-delegation *) - Test.tztest "unregistered delegate key (origination, small fee)" - `Quick (unregistered_delegate_key_init_origination ~fee:Tez.one_mutez); - Test.tztest "unregistered delegate key (origination, edge case fee)" - `Quick (unregistered_delegate_key_init_origination ~fee:(Tez.of_int 3_999_488)); - Test.tztest "unregistered delegate key (origination, large fee)" - `Quick (unregistered_delegate_key_init_origination ~fee:(Tez.of_int 10_000_000)); - - Test.tztest "unregistered delegate key (init with delegation, small fee)" - `Quick (unregistered_delegate_key_init_delegation ~fee:Tez.one_mutez); - Test.tztest "unregistered delegate key (init with delegation, max fee)" - `Quick (unregistered_delegate_key_init_delegation ~fee:Tez.max_tez); - - Test.tztest "unregistered delegate key (switch with delegation, small fee)" - `Quick (unregistered_delegate_key_switch_delegation ~fee:Tez.one_mutez) ; - Test.tztest "unregistered delegate key (switch with delegation, max fee)" - `Quick (unregistered_delegate_key_switch_delegation ~fee:Tez.max_tez) ; - - (* credit/debit 1μꜩ, no self-delegation *) - Test.tztest "unregistered delegate key - credit/debit 1μꜩ (origination, small fee)" - `Quick (unregistered_delegate_key_init_origination_credit_debit ~fee:Tez.one_mutez ~amount:Tez.one_mutez) ; - Test.tztest "unregistered delegate key - credit/debit 1μꜩ (origination, large fee)" - `Quick (unregistered_delegate_key_init_origination_credit_debit ~fee:Tez.max_tez ~amount:Tez.one_mutez) ; - - Test.tztest "unregistered delegate key - credit/debit 1μꜩ (init with delegation, small fee)" - `Quick (unregistered_delegate_key_init_delegation_credit_debit ~amount:Tez.one_mutez ~fee:Tez.one_mutez) ; - Test.tztest "unregistered delegate key - credit/debit 1μꜩ (init with delegation, large fee)" - `Quick (unregistered_delegate_key_init_delegation_credit_debit ~amount:Tez.one_mutez ~fee:Tez.max_tez) ; - - Test.tztest "unregistered delegate key - credit/debit 1μꜩ (switch with delegation, small fee)" - `Quick (unregistered_delegate_key_switch_delegation_credit_debit ~amount:Tez.one_mutez ~fee:Tez.one_mutez) ; - Test.tztest "unregistered delegate key - credit/debit 1μꜩ (switch with delegation, large fee)" - `Quick (unregistered_delegate_key_switch_delegation_credit_debit ~amount:Tez.one_mutez ~fee:Tez.max_tez) ; - - (* credit 1μꜩ, no self-delegation *) - Test.tztest "unregistered delegate key - credit 1μꜩ (origination, small fee)" - `Quick (unregistered_delegate_key_init_origination_credit ~fee:Tez.one_mutez ~amount:Tez.one_mutez) ; - Test.tztest "unregistered delegate key - credit 1μꜩ (origination, edge case fee)" - `Quick (unregistered_delegate_key_init_origination_credit ~fee:(Tez.of_int 3_999_488) ~amount:Tez.one_mutez) ; - Test.tztest "unregistered delegate key - credit 1μꜩ (origination, large fee)" - `Quick (unregistered_delegate_key_init_origination_credit ~fee:(Tez.of_int 10_000_000) ~amount:Tez.one_mutez) ; - - Test.tztest "unregistered delegate key - credit 1μꜩ (init with delegation, small fee)" - `Quick (unregistered_delegate_key_init_delegation_credit ~amount:Tez.one_mutez ~fee:Tez.one_mutez) ; - Test.tztest "unregistered delegate key - credit 1μꜩ (init with delegation, large fee)" - `Quick (unregistered_delegate_key_init_delegation_credit ~amount:Tez.one_mutez ~fee:Tez.max_tez) ; - - Test.tztest "unregistered delegate key - credit 1μꜩ (switch with delegation, small fee)" - `Quick (unregistered_delegate_key_switch_delegation_credit ~amount:Tez.one_mutez ~fee:Tez.one_mutez) ; - Test.tztest "unregistered delegate key - credit 1μꜩ (switch with delegation, large fee)" - `Quick (unregistered_delegate_key_switch_delegation_credit ~amount:Tez.one_mutez ~fee:Tez.max_tez) ; - - (* self delegation on unrevealed and unregistered contract *) - Test.tztest "unregistered and unrevealed self-delegation (small fee)" - `Quick (unregistered_and_unrevealed_self_delegate_key_init_delegation ~fee:Tez.one_mutez) ; - Test.tztest "unregistered and unrevealed self-delegation (large fee)" - `Quick (unregistered_and_unrevealed_self_delegate_key_init_delegation ~fee:Tez.max_tez) ; - - (* self delegation on unregistered contract *) - Test.tztest "unregistered and revealed self-delegation (small fee)" - `Quick (unregistered_and_revealed_self_delegate_key_init_delegation ~fee:Tez.one_mutez) ; - Test.tztest "unregistered and revealed self-delegation large fee)" - `Quick (unregistered_and_revealed_self_delegate_key_init_delegation ~fee:Tez.max_tez) ; - - (* self delegation on registered contract *) - Test.tztest "registered and revelead self-delegation" - `Quick registered_self_delegate_key_init_delegation ; - - (*** unregistered delegate key: failed self-delegation ***) - (* no token transfer, self-delegation *) - Test.tztest "failed self-delegation: no transaction" `Quick failed_self_delegation_no_transaction ; - (* credit 1μtz, debit 1μtz, self-delegation *) - Test.tztest "failed self-delegation: credit & debit 1μꜩ" `Quick (failed_self_delegation_emptied_implicit_contract Tez.one_mutez) ; - - (*** valid registration ***) - (* valid registration: credit 1 μꜩ, self delegation *) - Test.tztest "valid delegate registration: credit 1μꜩ, self delegation (init with delegation)" - `Quick (valid_delegate_registration_init_delegation_credit Tez.one_mutez) ; - Test.tztest "valid delegate registration: credit 1μꜩ, self delegation (switch with delegation)" - `Quick (valid_delegate_registration_switch_delegation_credit Tez.one_mutez) ; - (* valid registration: credit 1 μꜩ, self delegation, debit 1μꜩ *) - Test.tztest "valid delegate registration: credit 1μꜩ, self delegation, debit 1μꜩ (init with delegation)" - `Quick (valid_delegate_registration_init_delegation_credit_debit Tez.one_mutez) ; - Test.tztest "valid delegate registration: credit 1μꜩ, self delegation, debit 1μꜩ (switch with delegation)" - `Quick (valid_delegate_registration_switch_delegation_credit_debit Tez.one_mutez) ; - - (*** double registration ***) - Test.tztest "double registration" `Quick double_registration ; - Test.tztest "double registration when delegate account is emptied" `Quick double_registration_when_empty ; - Test.tztest "double registration when delegate account is emptied and then recredited" `Quick double_registration_when_recredited ; - ] - - - -(******************************************************************************) -(* Main *) -(******************************************************************************) - -let tests = - tests_bootstrap_contracts @ - tests_delegate_registration diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/double_baking.ml b/vendors/ligo-utils/tezos-protocol-alpha/test/double_baking.ml deleted file mode 100644 index 4e75cca34..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/double_baking.ml +++ /dev/null @@ -1,189 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -(** Double baking evidence operation may happen when a baker - baked two different blocks on the same level. *) - -open Protocol -open Alpha_context - -(****************************************************************) -(* Utility functions *) -(****************************************************************) - -let get_first_different_baker baker bakers = - return @@ List.find (fun baker' -> - Signature.Public_key_hash.(<>) baker baker') - bakers - -let get_first_different_bakers ctxt = - Context.get_bakers ctxt >>=? fun bakers -> - let baker_1 = List.hd bakers in - get_first_different_baker baker_1 (List.tl bakers) >>=? fun baker_2 -> - return (baker_1, baker_2) - -let get_first_different_endorsers ctxt = - Context.get_endorsers ctxt >>=? fun endorsers -> - let endorser_1 = (List.hd endorsers).delegate in - let endorser_2 = (List.hd (List.tl endorsers)).delegate in - return (endorser_1, endorser_2) - -(** Bake two block at the same level using the same policy (i.e. same - baker) *) -let block_fork ?policy contracts b = - let (contract_a, contract_b) = - List.hd contracts, List.hd (List.tl contracts) in - Op.transaction (B b) contract_a contract_b Alpha_context.Tez.one_cent >>=? fun operation -> - Block.bake ?policy ~operation b >>=? fun blk_a -> - Block.bake ?policy b >>=? fun blk_b -> - return (blk_a, blk_b) - -(****************************************************************) -(* Tests *) -(****************************************************************) - -(** Simple scenario where two blocks are baked by a same baker and - exposed by a double baking evidence operation *) -let valid_double_baking_evidence () = - Context.init 2 >>=? fun (b, contracts) -> - - Context.get_bakers (B b) >>=? fun bakers -> - let priority_0_baker = List.hd bakers in - - block_fork ~policy:(By_priority 0) contracts b >>=? fun (blk_a, blk_b) -> - - Op.double_baking (B blk_a) blk_a.header blk_b.header >>=? fun operation -> - Block.bake ~policy:(Excluding [ priority_0_baker ]) ~operation blk_a >>=? fun blk -> - - (* Check that the frozen deposit, the fees and rewards are removed *) - iter_s (fun kind -> - let contract = Alpha_context.Contract.implicit_contract priority_0_baker in - Assert.balance_is ~loc:__LOC__ (B blk) contract ~kind Tez.zero) - [ Deposit ; Fees ; Rewards ] - -(****************************************************************) -(* The following test scenarios are supposed to raise errors. *) -(****************************************************************) - -(** Check that a double baking operation fails if it exposes the same two blocks *) -let same_blocks () = - Context.init 2 >>=? fun (b, _contracts) -> - Block.bake b >>=? fun ba -> - Op.double_baking (B ba) ba.header ba.header >>=? fun operation -> - Block.bake ~operation ba >>= fun res -> - Assert.proto_error ~loc:__LOC__ res begin function - | Apply.Invalid_double_baking_evidence _ -> true - | _ -> false end >>=? fun () -> - return_unit - -(** Check that a double baking operation exposing two blocks with - different levels fails *) -let different_levels () = - Context.init 2 >>=? fun (b, contracts) -> - - block_fork ~policy:(By_priority 0) contracts b >>=? fun (blk_a, blk_b) -> - - Block.bake blk_b >>=? fun blk_b_2 -> - - Op.double_baking (B blk_a) blk_a.header blk_b_2.header >>=? fun operation -> - Block.bake ~operation blk_a >>= fun res -> - Assert.proto_error ~loc:__LOC__ res begin function - | Apply.Invalid_double_baking_evidence _ -> true - | _ -> false end - -(** Check that a double baking operation exposing two yet to be baked - blocks fails *) -let too_early_double_baking_evidence () = - Context.init 2 >>=? fun (b, contracts) -> - block_fork ~policy:(By_priority 0) contracts b >>=? fun (blk_a, blk_b) -> - - Op.double_baking (B b) blk_a.header blk_b.header >>=? fun operation -> - Block.bake ~operation b >>= fun res -> - Assert.proto_error ~loc:__LOC__ res begin function - | Apply.Too_early_double_baking_evidence _ -> true - | _ -> false end - -(** Check that after [preserved_cycles + 1], it is not possible to - create a double baking operation anymore *) -let too_late_double_baking_evidence () = - Context.init 2 >>=? fun (b, contracts) -> - Context.get_constants (B b) - >>=? fun Constants.{ parametric = { preserved_cycles ; _ } ; _ } -> - - block_fork ~policy:(By_priority 0) contracts b >>=? fun (blk_a, blk_b) -> - - fold_left_s (fun blk _ -> Block.bake_until_cycle_end blk) - blk_a (1 -- (preserved_cycles + 1)) >>=? fun blk -> - - Op.double_baking (B blk) blk_a.header blk_b.header >>=? fun operation -> - Block.bake ~operation blk >>= fun res -> - Assert.proto_error ~loc:__LOC__ res begin function - | Apply.Outdated_double_baking_evidence _ -> true - | _ -> false end - -(** Check that an invalid double baking evidence that exposes two block - baking with same level made by different bakers fails *) -let different_delegates () = - Context.init 2 >>=? fun (b, _) -> - - get_first_different_bakers (B b) >>=? fun (baker_1, baker_2) -> - Block.bake ~policy:(By_account baker_1) b >>=? fun blk_a -> - Block.bake ~policy:(By_account baker_2) b >>=? fun blk_b -> - - Op.double_baking (B blk_a) blk_a.header blk_b.header >>=? fun operation -> - Block.bake ~operation blk_a >>= fun e -> - Assert.proto_error ~loc:__LOC__ e begin function - | Apply.Inconsistent_double_baking_evidence _ -> true - | _ -> false end - -let wrong_signer () = - (* Baker_2 bakes a block but baker signs it. *) - let header_custom_signer baker baker_2 b = - Block.Forge.forge_header ~policy:(By_account baker_2) b >>=? fun header -> - Block.Forge.set_baker baker header |> - Block.Forge.sign_header - in - - Context.init 2 >>=? fun (b, _) -> - get_first_different_bakers (B b) >>=? fun (baker_1, baker_2) -> - Block.bake ~policy:(By_account baker_1) b >>=? fun blk_a -> - header_custom_signer baker_1 baker_2 b >>=? fun header_b -> - Op.double_baking (B blk_a) blk_a.header header_b >>=? fun operation -> - Block.bake ~operation blk_a >>= fun e -> - Assert.proto_error ~loc:__LOC__ e begin function - | Baking.Invalid_block_signature _ -> true - | _ -> false end - -let tests = [ - Test.tztest "valid double baking evidence" `Quick valid_double_baking_evidence ; - - (* Should fail*) - Test.tztest "same blocks" `Quick same_blocks ; - Test.tztest "different levels" `Quick different_levels ; - Test.tztest "too early double baking evidence" `Quick too_early_double_baking_evidence ; - Test.tztest "too late double baking evidence" `Quick too_late_double_baking_evidence ; - Test.tztest "different delegates" `Quick different_delegates ; - Test.tztest "wrong delegate" `Quick wrong_signer ; -] diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/double_endorsement.ml b/vendors/ligo-utils/tezos-protocol-alpha/test/double_endorsement.ml deleted file mode 100644 index f52f7dc96..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/double_endorsement.ml +++ /dev/null @@ -1,204 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -(** Double endorsement evidence operation may happen when an endorser - endorsed two different blocks on the same level. *) - -open Protocol -open Alpha_context - -(****************************************************************) -(* Utility functions *) -(****************************************************************) - -let get_first_different_baker baker bakers = - return @@ List.find (fun baker' -> - Signature.Public_key_hash.(<>) baker baker') - bakers - -let get_first_different_bakers ctxt = - Context.get_bakers ctxt >>=? fun bakers -> - let baker_1 = List.hd bakers in - get_first_different_baker baker_1 (List.tl bakers) >>=? fun baker_2 -> - return (baker_1, baker_2) - -let get_first_different_endorsers ctxt = - Context.get_endorsers ctxt >>=? fun endorsers -> - let endorser_1 = (List.hd endorsers) in - let endorser_2 = (List.hd (List.tl endorsers)) in - return (endorser_1, endorser_2) - -let block_fork b = - get_first_different_bakers (B b) >>=? fun (baker_1, baker_2) -> - Block.bake ~policy:(By_account baker_1) b >>=? fun blk_a -> - Block.bake ~policy:(By_account baker_2) b >>=? fun blk_b -> - return (blk_a, blk_b) - -(****************************************************************) -(* Tests *) -(****************************************************************) - -(** Simple scenario where two endorsements are made from the same - delegate and exposed by a double_endorsement operation. Also verify - that punishment is operated. *) -let valid_double_endorsement_evidence () = - Context.init 2 >>=? fun (b, _) -> - - block_fork b >>=? fun (blk_a, blk_b) -> - - Context.get_endorser (B blk_a) >>=? fun (delegate, _slots) -> - Op.endorsement ~delegate (B blk_a) () >>=? fun endorsement_a -> - Op.endorsement ~delegate (B blk_b) () >>=? fun endorsement_b -> - Block.bake ~operations:[Operation.pack endorsement_a] blk_a >>=? fun blk_a -> - (* Block.bake ~operations:[endorsement_b] blk_b >>=? fun _ -> *) - - Op.double_endorsement (B blk_a) endorsement_a endorsement_b >>=? fun operation -> - - (* Bake with someone different than the bad endorser *) - Context.get_bakers (B blk_a) >>=? fun bakers -> - get_first_different_baker delegate bakers >>=? fun baker -> - - Block.bake ~policy:(By_account baker) ~operation blk_a >>=? fun blk -> - - (* Check that the frozen deposit, the fees and rewards are removed *) - iter_s (fun kind -> - let contract = Alpha_context.Contract.implicit_contract delegate in - Assert.balance_is ~loc:__LOC__ (B blk) contract ~kind Tez.zero) - [ Deposit ; Fees ; Rewards ] - -(****************************************************************) -(* The following test scenarios are supposed to raise errors. *) -(****************************************************************) - -(** Check that an invalid double endorsement operation that exposes a valid - endorsement fails. *) -let invalid_double_endorsement () = - Context.init 10 >>=? fun (b, _) -> - Block.bake b >>=? fun b -> - - Op.endorsement (B b) () >>=? fun endorsement -> - Block.bake ~operation:(Operation.pack endorsement) b >>=? fun b -> - - Op.double_endorsement (B b) endorsement endorsement >>=? fun operation -> - Block.bake ~operation b >>= fun res -> - Assert.proto_error ~loc:__LOC__ res begin function - | Apply.Invalid_double_endorsement_evidence -> true - | _ -> false end - -(** Check that a double endorsement added at the same time as a double - endorsement operation fails. *) -let too_early_double_endorsement_evidence () = - Context.init 2 >>=? fun (b, _) -> - block_fork b >>=? fun (blk_a, blk_b) -> - - Context.get_endorser (B blk_a) >>=? fun (delegate, _slots) -> - Op.endorsement ~delegate (B blk_a) () >>=? fun endorsement_a -> - Op.endorsement ~delegate (B blk_b) () >>=? fun endorsement_b -> - - Op.double_endorsement (B b) endorsement_a endorsement_b >>=? fun operation -> - Block.bake ~operation b >>= fun res -> - Assert.proto_error ~loc:__LOC__ res begin function - | Apply.Too_early_double_endorsement_evidence _ -> true - | _ -> false end - -(** Check that after [preserved_cycles + 1], it is not possible - to create a double_endorsement anymore. *) -let too_late_double_endorsement_evidence () = - Context.init 2 >>=? fun (b, _) -> - Context.get_constants (B b) - >>=? fun Constants.{ parametric = { preserved_cycles ; _ } ; _ } -> - - block_fork b >>=? fun (blk_a, blk_b) -> - - Context.get_endorser (B blk_a) >>=? fun (delegate, _slots) -> - Op.endorsement ~delegate (B blk_a) () >>=? fun endorsement_a -> - Op.endorsement ~delegate (B blk_b) () >>=? fun endorsement_b -> - - fold_left_s (fun blk _ -> Block.bake_until_cycle_end blk) - blk_a (1 -- (preserved_cycles + 1)) >>=? fun blk -> - - Op.double_endorsement (B blk) endorsement_a endorsement_b >>=? fun operation -> - Block.bake ~operation blk >>= fun res -> - Assert.proto_error ~loc:__LOC__ res begin function - | Apply.Outdated_double_endorsement_evidence _ -> true - | _ -> false end - -(** Check that an invalid double endorsement evidence that expose two - endorsements made by two different endorsers fails. *) -let different_delegates () = - Context.init 2 >>=? fun (b, _) -> - - Block.bake b >>=? fun b -> - block_fork b >>=? fun (blk_a, blk_b) -> - Context.get_endorser (B blk_a) >>=? fun (endorser_a, _a_slots) -> - get_first_different_endorsers (B blk_b) >>=? fun (endorser_b1c, endorser_b2c) -> - let endorser_b = - if Signature.Public_key_hash.(=) endorser_a endorser_b1c.delegate - then endorser_b2c.delegate - else endorser_b1c.delegate - in - - Op.endorsement ~delegate:endorser_a (B blk_a) () >>=? fun e_a -> - Op.endorsement ~delegate:endorser_b (B blk_b) () >>=? fun e_b -> - Block.bake ~operation:(Operation.pack e_b) blk_b >>=? fun _ -> - Op.double_endorsement (B blk_b) e_a e_b >>=? fun operation -> - Block.bake ~operation blk_b >>= fun res -> - Assert.proto_error ~loc:__LOC__ res begin function - | Apply.Inconsistent_double_endorsement_evidence _ -> true - | _ -> false end - -(** Check that a double endorsement evidence that exposes a ill-formed - endorsement fails. *) -let wrong_delegate () = - Context.init ~endorsers_per_block:1 2 >>=? fun (b, contracts) -> - Error_monad.map_s (Context.Contract.manager (B b)) contracts >>=? fun accounts -> - let pkh1 = (List.nth accounts 0).Account.pkh in - let pkh2 = (List.nth accounts 1).Account.pkh in - - block_fork b >>=? fun (blk_a, blk_b) -> - Context.get_endorser (B blk_a) >>=? fun (endorser_a, _a_slots) -> - Op.endorsement ~delegate:endorser_a (B blk_a) () >>=? fun endorsement_a -> - Context.get_endorser (B blk_b) >>=? fun (endorser_b, _b_slots) -> - let delegate = - if Signature.Public_key_hash.equal pkh1 endorser_b - then pkh2 - else pkh1 - in - Op.endorsement ~delegate (B blk_b) () >>=? fun endorsement_b -> - - Op.double_endorsement (B blk_b) endorsement_a endorsement_b >>=? fun operation -> - Block.bake ~operation blk_b >>= fun e -> - Assert.proto_error ~loc:__LOC__ e begin function - | Baking.Unexpected_endorsement -> true - | _ -> false end - -let tests = [ - Test.tztest "valid double endorsement evidence" `Quick valid_double_endorsement_evidence ; - Test.tztest "invalid double endorsement evidence" `Quick invalid_double_endorsement ; - Test.tztest "too early double endorsement evidence" `Quick too_early_double_endorsement_evidence ; - Test.tztest "too late double endorsement evidence" `Quick too_late_double_endorsement_evidence ; - Test.tztest "different delegates" `Quick different_delegates ; - Test.tztest "wrong delegate" `Quick wrong_delegate ; -] diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/dune b/vendors/ligo-utils/tezos-protocol-alpha/test/dune deleted file mode 100644 index 44860d2cd..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/dune +++ /dev/null @@ -1,46 +0,0 @@ -(executable - (name main) - (libraries tezos-base - tezos-micheline - tezos-protocol-environment - alcotest-lwt - tezos-005-PsBabyM1-test-helpers - tezos-stdlib-unix - bip39 - tezos-protocol-005-PsBabyM1-parameters) - (flags (:standard -open Tezos_base__TzPervasives - -open Tezos_micheline - -open Tezos_protocol_005_PsBabyM1 - -open Tezos_005_PsBabyM1_test_helpers - ))) - -(alias - (name buildtest) - (package tezos-protocol-005-PsBabyM1-tests) - (deps main.exe)) - -(rule - (copy %{lib:tezos-protocol-005-PsBabyM1-parameters:test-parameters.json} - protocol_parameters.json)) - -; runs only the `Quick tests -(alias - (name runtest_proto_005_PsBabyM1) - (package tezos-protocol-005-PsBabyM1-tests) - (action (run %{exe:main.exe} -v -q))) - -; runs both `Quick and `Slow tests -(alias - (name runtest_slow) - (package tezos-protocol-005-PsBabyM1-tests) - (action (run %{exe:main.exe} -v))) - -(alias - (name runtest) - (package tezos-protocol-005-PsBabyM1-tests) - (deps (alias runtest_proto_005_PsBabyM1))) - -(alias - (name runtest_lint) - (deps (glob_files *.ml{,i})) - (action (run %{lib:tezos-tooling:lint.sh} %{deps}))) diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/endorsement.ml b/vendors/ligo-utils/tezos-protocol-alpha/test/endorsement.ml deleted file mode 100644 index d8d9444c6..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/endorsement.ml +++ /dev/null @@ -1,441 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -(** Endorsing a block adds an extra layer of confidence to the Tezos's - PoS algorithm. The block endorsing operation must be included in - the following block. Each endorser possess a number of slots - corresponding to their priority. After [preserved_cycles], a reward - is given to the endorser. This reward depends on the priority of - the block that contains the endorsements. *) - -open Protocol -open Alpha_context -open Test_utils -open Test_tez - -(****************************************************************) -(* Utility functions *) -(****************************************************************) - -let get_expected_reward ctxt ~priority ~baker ~endorsing_power = - begin if baker then - Context.get_baking_reward ctxt ~priority ~endorsing_power - else - return (Test_tez.Tez.of_int 0) - end >>=? fun baking_reward -> - Context.get_endorsing_reward ctxt ~priority ~endorsing_power >>=? fun endorsing_reward -> - Test_tez.Tez.(endorsing_reward +? baking_reward) >>?= fun reward -> return reward - -let get_expected_deposit ctxt ~baker ~endorsing_power = - Context.get_constants ctxt >>=? fun Constants. - { parametric = { endorsement_security_deposit ; - block_security_deposit ; _ } ; _ } -> - let open Environment in - let open Tez in - let baking_deposit = if baker then block_security_deposit else of_int 0 in - endorsement_security_deposit *? (Int64.of_int endorsing_power) >>?= fun endorsement_deposit -> - endorsement_deposit +? baking_deposit >>?= fun deposit -> return deposit - -(* [baker] is true if the [pkh] has also baked the current block, in - which case correspoding deposit and reward should be ajusted *) -let assert_endorser_balance_consistency ~loc ?(priority=0) ?(baker=false) ~endorsing_power - ctxt pkh initial_balance = - let contract = Contract.implicit_contract pkh in - get_expected_reward ctxt ~priority ~baker ~endorsing_power >>=? fun reward -> - get_expected_deposit ctxt ~baker ~endorsing_power >>=? fun deposit -> - - Assert.balance_was_debited ~loc ctxt contract initial_balance deposit >>=? fun () -> - Context.Contract.balance ~kind:Rewards ctxt contract >>=? fun reward_balance -> - Assert.equal_tez ~loc reward_balance reward >>=? fun () -> - Context.Contract.balance ~kind:Deposit ctxt contract >>=? fun deposit_balance -> - Assert.equal_tez ~loc deposit_balance deposit - -let delegates_with_slots endorsers = - List.map (fun (endorser: Delegate_services.Endorsing_rights.t) -> - endorser.delegate) - endorsers - -let endorsing_power endorsers = - List.fold_left - (fun sum (endorser: Delegate_services.Endorsing_rights.t) -> - sum + List.length endorser.slots) - 0 endorsers - -(****************************************************************) -(* Tests *) -(****************************************************************) - -(** Apply a single endorsement from the slot 0 endorser *) -let simple_endorsement () = - Context.init 5 >>=? fun (b, _) -> - Context.get_endorser (B b) >>=? fun (delegate, slots) -> - Op.endorsement ~delegate (B b) () >>=? fun op -> - Context.Contract.balance (B b) (Contract.implicit_contract delegate) >>=? fun initial_balance -> - let policy = Block.Excluding [ delegate ] in - Block.get_next_baker ~policy b >>=? fun (_, priority, _) -> - Block.bake - ~policy - ~operations:[Operation.pack op] - b >>=? fun b2 -> - assert_endorser_balance_consistency ~loc:__LOC__ - (B b2) ~priority ~endorsing_power:(List.length slots) - delegate initial_balance - -(** Apply a maximum number of endorsements. An endorser can be - selected twice. *) -let max_endorsement () = - let endorsers_per_block = 16 in - Context.init ~endorsers_per_block 32 >>=? fun (b, _) -> - - Context.get_endorsers (B b) >>=? fun endorsers -> - Assert.equal_int ~loc:__LOC__ - (List.length - (List.concat - (List.map - (fun { Alpha_services.Delegate.Endorsing_rights.slots ; _ } -> slots) - endorsers))) - endorsers_per_block >>=? fun () -> - - fold_left_s (fun (delegates, ops, balances) - (endorser : Alpha_services.Delegate.Endorsing_rights.t) -> - let delegate = endorser.delegate in - Context.Contract.balance (B b) (Contract.implicit_contract delegate) >>=? fun balance -> - Op.endorsement ~delegate (B b) () >>=? fun op -> - return (delegate :: delegates, - Operation.pack op :: ops, - (List.length endorser.slots, balance) :: balances) - ) - ([], [], []) - endorsers >>=? fun (delegates, ops, previous_balances) -> - - Block.bake ~policy:(Excluding delegates) ~operations:(List.rev ops) b >>=? fun b -> - - (* One account can endorse more than one time per level, we must - check that the bonds are summed up *) - iter_s (fun (endorser_account, (endorsing_power, previous_balance)) -> - assert_endorser_balance_consistency ~loc:__LOC__ - (B b) ~endorsing_power endorser_account previous_balance - ) (List.combine delegates previous_balances) - -(** Check every that endorsers' balances are consistent with different priorities *) -let consistent_priorities () = - let priorities = 0 -- 64 in - Context.init 64 >>=? fun (b, _) -> - - fold_left_s (fun (b, used_pkhes) priority -> - (* Choose an endorser that has not baked nor endorsed before *) - Context.get_endorsers (B b) >>=? fun endorsers -> - let endorser = - List.find_opt - (fun (e: Delegate_services.Endorsing_rights.t) -> - not (Signature.Public_key_hash.Set.mem e.delegate used_pkhes) - ) - endorsers in - match endorser with - | None -> return (b, used_pkhes) (* not enough fresh endorsers; we "stop" *) - | Some endorser -> - - Context.Contract.balance (B b) - (Contract.implicit_contract endorser.delegate) >>=? fun balance -> - - Op.endorsement ~delegate:endorser.delegate (B b) () >>=? fun operation -> - let operation = Operation.pack operation in - - Block.get_next_baker ~policy:(By_priority priority) b >>=? fun (baker, _, _) -> - let used_pkhes = Signature.Public_key_hash.Set.add baker used_pkhes in - let used_pkhes = Signature.Public_key_hash.Set.add endorser.delegate used_pkhes in - - (* Bake with a specific priority *) - Block.bake ~policy:(By_priority priority) ~operation b >>=? fun b -> - - let is_baker = Signature.Public_key_hash.(baker = endorser.delegate) in - - assert_endorser_balance_consistency ~loc:__LOC__ ~priority ~baker:is_baker (B b) - ~endorsing_power:(List.length endorser.slots) - endorser.delegate balance >>=? fun () -> - - return (b, used_pkhes) - ) (b, Signature.Public_key_hash.Set.empty) priorities >>=? fun _b -> return_unit - -(** Check that after [preserved_cycles] cycles the endorser gets his reward *) -let reward_retrieval () = - Context.init 5 >>=? fun (b, _) -> - Context.get_constants (B b) >>=? fun Constants. - { parametric = { preserved_cycles ; _ } ; _ } -> - Context.get_endorser (B b) >>=? fun (endorser, slots) -> - Context.Contract.balance (B b) (Contract.implicit_contract endorser) >>=? fun balance -> - Op.endorsement ~delegate:endorser (B b) () >>=? fun operation -> - let operation = Operation.pack operation in - let policy = Block.Excluding [ endorser ] in - Block.get_next_baker ~policy b >>=? fun (_, priority, _) -> - Block.bake ~policy ~operation b >>=? fun b -> - (* Bake (preserved_cycles + 1) cycles *) - fold_left_s (fun b _ -> - Block.bake_until_cycle_end ~policy:(Excluding [ endorser ]) b - ) b (0 -- preserved_cycles) >>=? fun b -> - get_expected_reward (B b) ~priority ~baker:false ~endorsing_power:(List.length slots) >>=? fun reward -> - Assert.balance_was_credited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser) balance reward - -(** Check that after [preserved_cycles] cycles endorsers get their - reward. Two endorsers are used and they endorse in different - cycles. *) -let reward_retrieval_two_endorsers () = - Context.init 5 >>=? fun (b, _) -> - Context.get_constants (B b) >>=? fun Constants. - { parametric = { preserved_cycles ; endorsement_reward ; endorsement_security_deposit ; _ } ; _ } -> - Context.get_endorsers (B b) >>=? fun endorsers -> - let endorser1 = List.hd endorsers in - let endorser2 = List.hd (List.tl endorsers) in - - Context.Contract.balance (B b) (Contract.implicit_contract endorser1.delegate) >>=? fun balance1 -> - Context.Contract.balance (B b) (Contract.implicit_contract endorser2.delegate) >>=? fun balance2 -> - Lwt.return Tez.(endorsement_security_deposit *? Int64.of_int (List.length endorser1.slots)) >>=? fun security_deposit1 -> - - (* endorser1 endorses the genesis block in cycle 0 *) - Op.endorsement ~delegate:endorser1.delegate (B b) () >>=? fun operation1 -> - - let policy = Block.Excluding [ endorser1.delegate ; endorser2.delegate ] in - Block.get_next_baker ~policy b >>=? fun (_, priority, _) -> - Tez.(endorsement_reward /? Int64.(succ (of_int priority))) >>?= fun reward_per_slot -> - Lwt.return Tez.(reward_per_slot *? Int64.of_int (List.length endorser1.slots)) >>=? fun reward1 -> - - (* bake next block, include endorsement of endorser1 *) - Block.bake ~policy ~operation:(Operation.pack operation1) b >>=? fun b -> - Assert.balance_was_debited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser1.delegate) balance1 security_deposit1 >>=? fun () -> - Assert.balance_is ~loc:__LOC__ (B b) (Contract.implicit_contract endorser2.delegate) balance2 >>=? fun () -> - - (* complete cycle 0 *) - Block.bake_until_cycle_end ~policy b >>=? fun b -> - Assert.balance_was_debited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser1.delegate) balance1 security_deposit1 >>=? fun () -> - Assert.balance_is ~loc:__LOC__ (B b) (Contract.implicit_contract endorser2.delegate) balance2 >>=? fun () -> - - (* get the slots of endorser2 for the current block *) - Context.get_endorsers (B b) >>=? fun endorsers -> - let same_endorser2 endorser = - Signature.Public_key_hash.(endorser.Delegate_services.Endorsing_rights.delegate = endorser2.delegate) in - let endorser2 = List.find same_endorser2 endorsers in (* No exception raised: in sandboxed mode endorsers do not change between blocks *) - Lwt.return Tez.(endorsement_security_deposit *? Int64.of_int (List.length endorser2.slots)) >>=? fun security_deposit2 -> - - (* endorser2 endorses the last block in cycle 0 *) - Op.endorsement ~delegate:endorser2.delegate (B b) () >>=? fun operation2 -> - - (* bake first block in cycle 1, include endorsement of endorser2 *) - Block.bake ~policy ~operation:(Operation.pack operation2) b >>=? fun b -> - - let priority = b.header.protocol_data.contents.priority in - Tez.(endorsement_reward /? Int64.(succ (of_int priority))) >>?= fun reward_per_slot -> - Lwt.return Tez.(reward_per_slot *? Int64.of_int (List.length endorser2.slots)) >>=? fun reward2 -> - - Assert.balance_was_debited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser1.delegate) balance1 security_deposit1 >>=? fun () -> - Assert.balance_was_debited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser2.delegate) balance2 security_deposit2 >>=? fun () -> - - (* bake [preserved_cycles] cycles *) - fold_left_s (fun b _ -> - Assert.balance_was_debited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser1.delegate) balance1 security_deposit1 >>=? fun () -> - Assert.balance_was_debited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser2.delegate) balance2 security_deposit2 >>=? fun () -> - Block.bake_until_cycle_end ~policy b - ) b (1 -- preserved_cycles) >>=? fun b -> - - Assert.balance_was_credited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser1.delegate) balance1 reward1 >>=? fun () -> - Assert.balance_was_debited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser2.delegate) balance2 security_deposit2 >>=? fun () -> - - (* bake cycle [preserved_cycle + 1] *) - Block.bake_until_cycle_end ~policy b >>=? fun b -> - Assert.balance_was_credited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser1.delegate) balance1 reward1 >>=? fun () -> - Assert.balance_was_credited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser2.delegate) balance2 reward2 - - - -(****************************************************************) -(* The following test scenarios are supposed to raise errors. *) -(****************************************************************) - -(** Wrong endorsement predecessor : apply an endorsement with an - incorrect block predecessor *) -let wrong_endorsement_predecessor () = - Context.init 5 >>=? fun (b, _) -> - - Context.get_endorser (B b) >>=? fun (genesis_endorser, _slots) -> - Block.bake b >>=? fun b' -> - Op.endorsement ~delegate:genesis_endorser ~signing_context:(B b) (B b') () >>=? fun operation -> - let operation = Operation.pack operation in - Block.bake ~operation b' >>= fun res -> - - Assert.proto_error ~loc:__LOC__ res begin function - | Apply.Wrong_endorsement_predecessor _ -> true - | _ -> false - end - -(** Invalid_endorsement_level : apply an endorsement with an incorrect - level (i.e. the predecessor level) *) -let invalid_endorsement_level () = - Context.init 5 >>=? fun (b, _) -> - Context.get_level (B b) >>=? fun genesis_level -> - Block.bake b >>=? fun b -> - Op.endorsement ~level:genesis_level (B b) () >>=? fun operation -> - let operation = Operation.pack operation in - Block.bake ~operation b >>= fun res -> - - Assert.proto_error ~loc:__LOC__ res begin function - | Apply.Invalid_endorsement_level -> true - | _ -> false - end - -(** Duplicate endorsement : apply an endorsement that has already been done *) -let duplicate_endorsement () = - Context.init 5 >>=? fun (b, _) -> - Incremental.begin_construction b >>=? fun inc -> - Op.endorsement (B b) () >>=? fun operation -> - let operation = Operation.pack operation in - Incremental.add_operation inc operation >>=? fun inc -> - Op.endorsement (B b) () >>=? fun operation -> - let operation = Operation.pack operation in - Incremental.add_operation inc operation >>= fun res -> - - Assert.proto_error ~loc:__LOC__ res begin function - | Apply.Duplicate_endorsement _ -> true - | _ -> false - end - -(** Apply a single endorsement from the slot 0 endorser *) -let not_enough_for_deposit () = - Context.init 5 ~endorsers_per_block:1 >>=? fun (b_init, contracts) -> - Error_monad.map_s (fun c -> - Context.Contract.manager (B b_init) c >>=? fun m -> return (m, c)) contracts >>=? - fun managers -> - Block.bake b_init >>=? fun b -> - (* retrieve the level 2's endorser *) - Context.get_endorser (B b) >>=? fun (endorser, _slots) -> - let _, contract_other_than_endorser = - List.find (fun (c, _) -> not (Signature.Public_key_hash.equal c.Account.pkh endorser)) - managers - in - let _, contract_of_endorser = - List.find (fun (c, _) -> (Signature.Public_key_hash.equal c.Account.pkh endorser)) - managers - in - Context.Contract.balance (B b) - (Contract.implicit_contract endorser) >>=? fun initial_balance -> - (* Empty the future endorser account *) - Op.transaction (B b_init) contract_of_endorser contract_other_than_endorser initial_balance >>=? fun op_trans -> - Block.bake ~operation:op_trans b_init >>=? fun b -> - (* Endorse with a zero balance *) - Op.endorsement ~delegate:endorser (B b) () >>=? fun op_endo -> - Block.bake - ~policy:(Excluding [endorser]) - ~operation:(Operation.pack op_endo) - b >>= fun res -> - Assert.proto_error ~loc:__LOC__ res begin function - | Delegate_storage.Balance_too_low_for_deposit _ -> true - | _ -> false - end - -(* check that a block with not enough endorsement cannot be baked *) -let endorsement_threshold () = - let initial_endorsers = 28 in - let num_accounts = 100 in - Context.init ~initial_endorsers num_accounts >>=? fun (b, _) -> - Context.get_endorsers (B b) >>=? fun endorsers -> - let num_endorsers = List.length endorsers in - - (* we try to bake with more and more endorsers, but at each - iteration with a timestamp smaller than required *) - iter_s (fun i -> - (* the priority is chosen rather arbitrarily *) - let priority = num_endorsers - i in - let crt_endorsers = List.take_n i endorsers in - let endorsing_power = endorsing_power crt_endorsers in - let delegates = delegates_with_slots crt_endorsers in - map_s (fun x -> Op.endorsement ~delegate:x (B b) ()) delegates >>=? fun ops -> - Context.get_minimal_valid_time (B b) ~priority ~endorsing_power >>=? fun timestamp -> - (* decrease the timestamp by one second *) - let seconds = Int64.(sub (of_string (Timestamp.to_seconds_string timestamp)) 1L) in - match Timestamp.of_seconds (Int64.to_string seconds) with - | None -> failwith "timestamp to/from string manipulation failed" - | Some timestamp -> - Block.bake ~timestamp ~policy:(By_priority priority) - ~operations:(List.map Operation.pack ops) b >>= fun b2 -> - Assert.proto_error ~loc:__LOC__ b2 begin function - | Baking.Timestamp_too_early _ - | Apply.Not_enough_endorsements_for_priority _ -> true - | _ -> false - end) - (0 -- (num_endorsers-1)) >>=? fun () -> - - (* we bake with all endorsers endorsing, at the right time *) - let priority = 0 in - let endorsing_power = endorsing_power endorsers in - let delegates = delegates_with_slots endorsers in - map_s (fun delegate -> Op.endorsement ~delegate (B b) ()) delegates >>=? fun ops -> - Context.get_minimal_valid_time (B b) ~priority ~endorsing_power >>=? fun timestamp -> - Block.bake - ~policy:(By_priority priority) - ~timestamp - ~operations:(List.map Operation.pack ops) - b >>= fun _ -> return_unit - -let test_fitness_gap () = - let num_accounts = 5 in - Context.init num_accounts >>=? fun (b, _) -> - begin - match Fitness_repr.to_int64 b.header.shell.fitness with - | Ok fitness -> - return (Int64.to_int fitness) - | Error _ -> assert false - end >>=? fun fitness -> - Context.get_endorser (B b) >>=? fun (delegate, _slots) -> - Op.endorsement ~delegate (B b) () >>=? fun op -> - (* bake at priority 0 succeed thanks to enough endorsements *) - Block.bake - ~policy:(By_priority 0) - ~operations:[Operation.pack op] - b >>=? fun b -> - begin - match Fitness_repr.to_int64 b.header.shell.fitness with - | Ok new_fitness -> - return ((Int64.to_int new_fitness) - fitness) - | Error _ -> assert false - end >>=? fun res -> - (* in Emmy+, the fitness increases by 1, so the difference between - the fitness at level 1 and at level 0 is 1, independently if the - number fo endorements (here 1) *) - Assert.equal_int ~loc:__LOC__ res 1 >>=? fun () -> - return_unit - -let tests = [ - Test.tztest "Simple endorsement" `Quick simple_endorsement ; - Test.tztest "Maximum endorsement" `Quick max_endorsement ; - Test.tztest "Consistent priorities" `Quick consistent_priorities ; - Test.tztest "Reward retrieval" `Quick reward_retrieval ; - Test.tztest "Reward retrieval two endorsers" `Quick reward_retrieval_two_endorsers ; - Test.tztest "Endorsement threshold" `Quick endorsement_threshold ; - Test.tztest "Fitness gap" `Quick test_fitness_gap ; - - (* Fail scenarios *) - Test.tztest "Wrong endorsement predecessor" `Quick wrong_endorsement_predecessor ; - Test.tztest "Invalid endorsement level" `Quick invalid_endorsement_level ; - Test.tztest "Duplicate endorsement" `Quick duplicate_endorsement ; - Test.tztest "Not enough for deposit" `Quick not_enough_for_deposit ; -] diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/account.ml b/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/account.ml deleted file mode 100644 index 985e2b0ec..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/account.ml +++ /dev/null @@ -1,92 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol - -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 ?seed () = - let (pkh, pk, sk) = Signature.generate_key ?seed () 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 activator_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 ?(initial_balances = []) n : (t * Tez_repr.t) list = - Signature.Public_key_hash.Table.clear known_accounts ; - let default_amount = Tez_repr.of_mutez_exn 4_000_000_000_000L in - let amount i = match List.nth_opt initial_balances i with - | None -> default_amount - | Some a -> Tez_repr.of_mutez_exn a - in - List.map (fun i -> - 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 i) - (0--(n-1)) - -let commitment_secret = - Blinded_public_key_hash.activation_code_of_hex - "aaaaaaaaaaaaaaaaaaaabbbbbbbbbbbbbbbbbbbb" - -let new_commitment ?seed () = - let (pkh, pk, sk) = Signature.generate_key ?seed ~algo:Ed25519 () in - let unactivated_account = { pkh; pk; sk } in - let open Commitment_repr in - let pkh = match pkh with Ed25519 pkh -> pkh | _ -> assert false in - let bpkh = Blinded_public_key_hash.of_ed25519_pkh commitment_secret pkh in - Lwt.return @@ Environment.wrap_error @@ - Tez_repr.(one *? 4_000L) >>=? fun amount -> - return @@ (unactivated_account, { blinded_public_key_hash = bpkh ; amount }) diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/account.mli b/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/account.mli deleted file mode 100644 index 66ef7eb94..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/account.mli +++ /dev/null @@ -1,57 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol - -type t = { - pkh : Signature.Public_key_hash.t ; - pk : Signature.Public_key.t ; - sk : Signature.Secret_key.t ; -} -type account = t - -val known_accounts: t Signature.Public_key_hash.Table.t - -val activator_account: account -val dummy_account: account - -val new_account: ?seed:MBytes.t -> 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 ?initial_balances n] : generates [n] random - accounts with the initial balance of the [i]th account given by the - [i]th value in the list [initial_balances] or otherwise - 4.000.000.000 tz (if the list is too short); and add them to the - global account state *) -val generate_accounts : ?initial_balances:int64 list -> int -> (t * Tez_repr.t) list - -val commitment_secret : Blinded_public_key_hash.activation_code - -val new_commitment : ?seed:MBytes.t -> unit -> - (account * Commitment_repr.t) tzresult Lwt.t diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/assert.ml b/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/assert.ml deleted file mode 100644 index bdfa1b0a8..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/assert.ml +++ /dev/null @@ -1,124 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol - -let error ~loc v f = - match v with - | Error err when List.exists f err -> - return_unit - | 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 - | 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_unit - -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_unit - -(* tez *) -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 - -(* int *) -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 - -(* bool *) -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 - -(* pkh *) -let equal_pkh ~loc (a:Signature.Public_key_hash.t) (b:Signature.Public_key_hash.t) = - let module PKH = Signature.Public_key_hash in - equal ~loc PKH.equal "Public key hashes aren't equal" PKH.pp a b - -let not_equal_pkh ~loc (a:Signature.Public_key_hash.t) (b:Signature.Public_key_hash.t) = - let module PKH = Signature.Public_key_hash in - not_equal ~loc PKH.equal "Public key hashes are equal" PKH.pp 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 |> - 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/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/block.ml b/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/block.ml deleted file mode 100644 index 4dcc7f9e8..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/block.ml +++ /dev/null @@ -1,418 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol -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.packed list ; - context : Tezos_protocol_environment.Context.t ; -} -type block = t - -let rpc_context block = { - Environment.Updater.block_hash = block.hash ; - block_header = block.header.shell ; - context = block.context ; -} - -let rpc_ctxt = - new Environment.proto_rpc_context_of_directory - rpc_context 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.Baking_rights.get rpc_ctxt - ~all:true - ~max_priority:(priority+1) block >>=? fun bakers -> - let { Alpha_services.Delegate.Baking_rights.delegate = pkh ; - timestamp; _ } = List.find (fun { Alpha_services.Delegate.Baking_rights.priority = p ; _ } -> p = priority) bakers in - return (pkh, priority, Option.unopt_exn (Failure "") timestamp) - -let get_next_baker_by_account pkh block = - Alpha_services.Delegate.Baking_rights.get rpc_ctxt - ~delegates:[pkh] - ~max_priority:256 block >>=? fun bakers -> - let { Alpha_services.Delegate.Baking_rights.delegate = pkh ; - timestamp ; priority ; _ } = List.hd bakers in - return (pkh, priority, Option.unopt_exn (Failure "") timestamp) - -let get_next_baker_excluding excludes block = - Alpha_services.Delegate.Baking_rights.get rpc_ctxt - ~max_priority:256 block >>=? fun bakers -> - let { Alpha_services.Delegate.Baking_rights.delegate = pkh ; - timestamp ; priority ; _ } = - List.find - (fun { Alpha_services.Delegate.Baking_rights.delegate ; _ } -> - not (List.mem delegate excludes)) - bakers in - return (pkh, priority, Option.unopt_exn (Failure "") 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 - -let get_endorsing_power b = - fold_left_s (fun acc (op: Operation.packed) -> - let Operation_data data = op.protocol_data in - match data.contents with - | Single Endorsement _ -> - Alpha_services.Delegate.Endorsing_power.get - rpc_ctxt b op Chain_id.zero >>=? fun endorsement_power -> - return (acc + endorsement_power) - | _ -> return acc) - 0 b.operations - -module Forge = struct - - type header = { - baker : public_key_hash ; (* the signer of the block *) - 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_contents - ?(proof_of_work_nonce = default_proof_of_work_nonce) - ~priority ~seed_nonce_hash () = - Block_header.{ priority ; - proof_of_work_nonce ; - seed_nonce_hash } - - let make_shell - ~level ~predecessor ~timestamp ~fitness ~operations_hash = - 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 ; - } - - let set_seed_nonce_hash seed_nonce_hash { baker ; shell ; contents } = - { baker ; shell ; contents = { contents with seed_nonce_hash } } - - let set_baker baker header = { header with baker } - - let sign_header { baker ; shell ; contents } = - Account.find baker >>=? 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 Chain_id.zero) delegate.sk unsigned_bytes in - Block_header.{ shell ; protocol_data = { contents ; signature } } |> - return - - let forge_header - ?(policy = By_priority 0) - ?timestamp - ?(operations = []) pred = - dispatch_policy policy pred >>=? fun (pkh, priority, _timestamp) -> - Alpha_services.Delegate.Minimal_valid_time.get - rpc_ctxt pred priority 0 >>=? fun expected_timestamp -> - let timestamp = Option.unopt ~default:expected_timestamp timestamp in - 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.Helpers.current_level ~offset:1l (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_packed operations in - let operations_hash = Operation_list_list_hash.compute - [Operation_list_hash.compute hashes] in - let shell = make_shell ~level ~predecessor:pred.hash - ~timestamp ~fitness ~operations_hash in - let contents = make_contents ~priority ~seed_nonce_hash () in - return { baker = pkh ; shell ; contents } - - (* 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 - ?(with_commitments = false) - constants - header - initial_accounts - = - let open Tezos_protocol_005_PsBabyM1_parameters in - let bootstrap_accounts = - List.map (fun (Account.{ pk ; pkh ; _ }, amount) -> - Default_parameters.make_bootstrap_account (pkh, pk, amount) - ) initial_accounts - in - - let parameters = - Default_parameters.parameters_of_constants - ~bootstrap_accounts - ~with_commitments - constants in - let json = Default_parameters.json_of_parameters parameters in - let proto_params = - Data_encoding.Binary.to_bytes_exn Data_encoding.json json - in - Tezos_protocol_environment.Context.( - let empty = Memory_context.empty in - set empty ["version"] (MBytes.of_string "genesis") >>= fun ctxt -> - set ctxt protocol_param_key proto_params - ) >>= fun ctxt -> - Main.init ctxt header - >|= Environment.wrap_error >>=? fun { context; _ } -> - return context - -let genesis_with_parameters parameters = - let hash = - Block_hash.of_b58check_exn "BLockGenesisGenesisGenesisGenesisGenesisCCCCCeZiLHU" - in - let shell = Forge.make_shell - ~level:0l - ~predecessor:hash - ~timestamp:Time.Protocol.epoch - ~fitness: (Fitness_repr.from_int64 0L) - ~operations_hash: Operation_list_list_hash.zero in - let contents = Forge.make_contents - ~priority:0 - ~seed_nonce_hash:None () in - let open Tezos_protocol_005_PsBabyM1_parameters in - let json = Default_parameters.json_of_parameters parameters in - let proto_params = - Data_encoding.Binary.to_bytes_exn Data_encoding.json json - in - Tezos_protocol_environment.Context.( - let empty = Memory_context.empty in - set empty ["version"] (MBytes.of_string "genesis") >>= fun ctxt -> - set ctxt protocol_param_key proto_params - ) >>= fun ctxt -> - Main.init ctxt shell - >|= Environment.wrap_error >>=? fun { context; _ } -> - let block = { hash ; - header = { shell ; - protocol_data = { - contents = contents ; - signature = Signature.zero ; - } } ; - operations = [] ; - context ; - } in - return block - -(* if no parameter file is passed we check in the current directory - where the test is run *) -let genesis - ?with_commitments - ?endorsers_per_block - ?initial_endorsers - ?min_proposal_quorum - (initial_accounts : (Account.t * Tez_repr.t) list) - = - if initial_accounts = [] then - Pervasives.failwith "Must have one account with a roll to bake"; - - let open Tezos_protocol_005_PsBabyM1_parameters in - let constants = Default_parameters.constants_test in - let endorsers_per_block = - Option.unopt ~default:constants.endorsers_per_block endorsers_per_block in - let initial_endorsers = - Option.unopt ~default:constants.initial_endorsers initial_endorsers in - let min_proposal_quorum = - Option.unopt ~default:constants.min_proposal_quorum min_proposal_quorum in - let constants = { constants with endorsers_per_block ; initial_endorsers ; min_proposal_quorum } in - - (* Check there is at least one roll *) - begin try - let open Test_utils in - fold_left_s (fun acc (_, amount) -> - Environment.wrap_error @@ - Tez_repr.(+?) acc amount >>?= fun acc -> - if acc >= constants.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_unit - end >>=? fun () -> - - check_constants_consistency constants >>=? fun () -> - - let hash = - Block_hash.of_b58check_exn "BLockGenesisGenesisGenesisGenesisGenesisCCCCCeZiLHU" - in - let shell = Forge.make_shell - ~level:0l - ~predecessor:hash - ~timestamp:Time.Protocol.epoch - ~fitness: (Fitness_repr.from_int64 0L) - ~operations_hash: Operation_list_list_hash.zero in - let contents = Forge.make_contents - ~priority:0 - ~seed_nonce_hash:None () in - initial_context - ?with_commitments - constants - shell - initial_accounts - >>=? fun context -> - let block = - { hash ; - header = { - shell = shell ; - protocol_data = { - contents = contents ; - signature = Signature.zero ; - } ; - }; - operations = [] ; - context ; - } - in - return block - -(********* Baking *************) - -let apply header ?(operations = []) pred = - begin - let open Environment.Error_monad in - Main.begin_application - ~chain_id: Chain_id.zero - ~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 -> - apply_operation vstate op >>=? fun (state, _result) -> - return state) - vstate operations >>=? fun vstate -> - Main.finalize_block vstate >>=? fun (validation, _result) -> - return validation.context - end >|= Environment.wrap_error >>|? fun context -> - let hash = Block_header.hash header in - { hash ; header ; operations ; context } - -let bake ?policy ?timestamp ?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 ?timestamp ?policy ?operations pred >>=? fun header -> - Forge.sign_header header >>=? fun header -> - apply header ?operations pred - -(********** Cycles ****************) - -(* This function is duplicated from Context to avoid a cyclic dependency *) -let get_constants b = - Alpha_services.Constants.all rpc_ctxt b - -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 - -let bake_until_n_cycle_end ?policy n b = - Error_monad.fold_left_s - (fun b _ -> bake_until_cycle_end ?policy b) b (1 -- n) - -let bake_until_cycle ?policy cycle (b:t) = - get_constants b >>=? fun Constants.{ parametric = { blocks_per_cycle ; _ } ; _ } -> - let rec loop (b:t) = - let current_cycle = - let current_level = b.header.shell.level in - let current_cycle = Int32.div current_level blocks_per_cycle in - current_cycle - in - if Int32.equal (Cycle.to_int32 cycle) current_cycle then - return b - else - bake_until_cycle_end ?policy b >>=? fun b -> - loop b - in - loop b diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/block.mli b/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/block.mli deleted file mode 100644 index 9b93f09ef..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/block.mli +++ /dev/null @@ -1,137 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol -open Alpha_context - -type t = { - hash : Block_hash.t ; - header : Block_header.t ; - operations : Operation.packed list ; - context : Tezos_protocol_environment.Context.t ; (** Resulting context *) -} -type block = t - -val rpc_ctxt: t Environment.RPC_context.simple - -(** Policies to select the next baker: - - [By_priority p] selects the baker at priority [p] - - [By_account pkh] selects the first slot for baker [pkh] - - [Excluding pkhs] selects the first baker that doesn't belong to [pkhs] -*) -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.Protocol.t) tzresult Lwt.t - -val get_endorsing_power: block -> int 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 -> - ?timestamp: Timestamp.time -> - ?operations: Operation.packed list -> - t -> header tzresult Lwt.t - - (** Sets uniquely seed_nonce_hash of a header *) - val set_seed_nonce_hash: - Nonce_hash.t option -> header -> header - - (** Sets the baker that will sign the header to an arbitrary pkh *) - val set_baker: - public_key_hash -> header -> header - - (** Signs the header with the key of the baker configured in the header. - The header can no longer be modified, only applied. *) - val sign_header: - header -> - Block_header.block_header tzresult Lwt.t - -end - -(** [genesis accounts] : generates an initial block with the - given constants [] and initializes [accounts] with their - associated amounts. -*) -val genesis: - ?with_commitments:bool -> - ?endorsers_per_block:int -> - ?initial_endorsers: int -> - ?min_proposal_quorum: int32 -> - (Account.t * Tez_repr.tez) list -> block tzresult Lwt.t - -val genesis_with_parameters: Parameters_repr.t -> block tzresult Lwt.t - -(** Applies a signed header and its operations to a block and - obtains a new block *) -val apply: - Block_header.block_header -> - ?operations: Operation.packed 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], [sign_header] and [apply]. - These functions should be used instead of bake to craft unusual blocks for - testing together with setters for properties of the headers. - For examples see seed.ml or double_baking.ml -*) -val bake: - ?policy: baker_policy -> - ?timestamp: Timestamp.time -> - ?operation: Operation.packed -> - ?operations: Operation.packed 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 - -(** Bakes enough blocks to end [n] cycles. *) -val bake_until_n_cycle_end : ?policy:baker_policy -> int -> t -> t tzresult Lwt.t - -(** Bakes enough blocks to reach the cycle. *) -val bake_until_cycle : ?policy:baker_policy -> Cycle.t -> t -> t tzresult Lwt.t diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/context.ml b/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/context.ml deleted file mode 100644 index 720e37fa7..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/context.ml +++ /dev/null @@ -1,285 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol -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 - |> Environment.wrap_error - |> Lwt.return - -let rpc_ctxt = object - method call_proto_service0 : - 'm 'q 'i 'o. - ([< RPC_service.meth ] as 'm, Environment.RPC_context.t, 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, Environment.RPC_context.t, 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, Environment.RPC_context.t, (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, Environment.RPC_context.t, ((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.Endorsing_rights.get rpc_ctxt ctxt - -let get_endorser ctxt = - Alpha_services.Delegate.Endorsing_rights.get rpc_ctxt ctxt >>=? fun endorsers -> - let endorser = List.hd endorsers in - return (endorser.delegate, endorser.slots) - -let get_bakers ctxt = - Alpha_services.Delegate.Baking_rights.get - ~max_priority:256 - rpc_ctxt ctxt >>=? fun bakers -> - return (List.map - (fun p -> p.Alpha_services.Delegate.Baking_rights.delegate) - bakers) - -let get_seed_nonce_hash ctxt = - let header = - match ctxt with - | B { header ; _ } -> header - | I i -> Incremental.header i in - match header.protocol_data.contents.seed_nonce_hash with - | None -> failwith "No committed nonce" - | Some hash -> return hash - -let get_seed ctxt = Alpha_services.Seed.get rpc_ctxt ctxt - -let get_constants ctxt = - Alpha_services.Constants.all rpc_ctxt ctxt - -let get_minimal_valid_time ctxt ~priority ~endorsing_power = - Alpha_services.Delegate.Minimal_valid_time.get rpc_ctxt ctxt priority endorsing_power - - -let get_baking_reward ctxt ~priority ~endorsing_power = - get_constants ctxt >>=? fun Constants. - { parametric = { block_reward ; endorsers_per_block ; _ } ; _ } -> - let prio_factor_denominator = Int64.(succ (of_int priority)) in - let endo_factor_numerator = Int64.of_int (8 + 2 * endorsing_power / endorsers_per_block) in - let endo_factor_denominator = 10L in - Lwt.return - Test_tez.Tez.( - block_reward *? endo_factor_numerator >>? fun val1 -> - val1 /? endo_factor_denominator >>? fun val2 -> - val2 /? prio_factor_denominator) - -let get_endorsing_reward ctxt ~priority ~endorsing_power = - get_constants ctxt >>=? fun Constants. - { parametric = { endorsement_reward ; _ } ; _ } -> - let open Test_utils in - Test_tez.Tez.( - endorsement_reward /? Int64.(succ (of_int priority)) >>?= fun reward_per_slot -> - reward_per_slot *? (Int64.of_int endorsing_power) >>?= fun reward -> - return reward) - - -(* Voting *) - -module Vote = struct - - let get_ballots ctxt = - Alpha_services.Voting.ballots rpc_ctxt ctxt - - let get_ballot_list ctxt = - Alpha_services.Voting.ballot_list rpc_ctxt ctxt - - let get_voting_period ctxt = - Alpha_services.Helpers.current_level rpc_ctxt ~offset:1l ctxt >>=? fun l -> - return l.voting_period - - let get_voting_period_position ctxt = - Alpha_services.Helpers.current_level rpc_ctxt ~offset:1l ctxt >>=? fun l -> - return l.voting_period_position - - let get_current_period_kind ctxt = - Alpha_services.Voting.current_period_kind rpc_ctxt ctxt - - let get_current_quorum ctxt = - Alpha_services.Voting.current_quorum rpc_ctxt ctxt - - let get_listings ctxt = - Alpha_services.Voting.listings rpc_ctxt ctxt - - let get_proposals ctxt = - Alpha_services.Voting.proposals rpc_ctxt ctxt - - let get_current_proposal ctxt = - Alpha_services.Voting.current_proposal rpc_ctxt ctxt - - let get_protocol (b:Block.t) = - Tezos_protocol_environment.Context.get b.context ["protocol"] >>= function - | None -> assert false - | Some p -> Lwt.return (Protocol_hash.of_bytes_exn p) - - let get_participation_ema (b:Block.t) = - Environment.Context.get b.context ["votes"; "participation_ema"] >>= function - | None -> assert false - | Some bytes -> return (MBytes.get_int32 bytes 0) - - let set_participation_ema (b:Block.t) ema = - let bytes = MBytes.make 4 '\000' in - MBytes.set_int32 bytes 0 ema ; - Environment.Context.set b.context - ["votes"; "participation_ema"] bytes >>= fun context -> - Lwt.return { b with context } - -end - -module Contract = struct - - let pp = Alpha_context.Contract.pp - - 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_balance_by_cycle - rpc_ctxt ctxt pkh >>=? fun map -> - Lwt.return @@ - Cycle.Map.fold - (fun _cycle { Delegate.deposit ; fees ; rewards } acc -> - acc >>?fun acc -> - match kind with - | Deposit -> Test_tez.Tez.(acc +? deposit) - | Fees -> Test_tez.Tez.(acc +? fees) - | Rewards -> Test_tez.Tez.(acc +? rewards) - | _ -> assert false) - map - (Ok Tez.zero) - end - - let counter ctxt contract = - match Contract.is_implicit contract with - | None -> invalid_arg "Helpers.Context.counter" - | Some mgr -> - Alpha_services.Contract.counter rpc_ctxt ctxt mgr - - let manager _ contract = - match Contract.is_implicit contract with - | None -> invalid_arg "Helpers.Context.manager" - | Some pkh -> Account.find pkh - - let is_manager_key_revealed ctxt contract = - match Contract.is_implicit contract with - | None -> invalid_arg "Helpers.Context.is_manager_key_revealed" - | Some mgr -> - Alpha_services.Contract.manager_key rpc_ctxt ctxt mgr >>=? fun res -> - return (res <> None) - - let delegate ctxt contract = - Alpha_services.Contract.delegate rpc_ctxt ctxt contract - - let delegate_opt ctxt contract = - Alpha_services.Contract.delegate_opt rpc_ctxt ctxt contract - -end - -module Delegate = struct - - type info = Delegate_services.info = { - balance: Tez.t ; - frozen_balance: Tez.t ; - frozen_balance_by_cycle: Delegate.frozen_balance Cycle.Map.t ; - staking_balance: Tez.t ; - delegated_contracts: Contract_repr.t list ; - delegated_balance: Tez.t ; - deactivated: bool ; - grace_period: Cycle.t ; - } - - let info ctxt pkh = - Alpha_services.Delegate.info rpc_ctxt ctxt pkh - -end - -let init - ?endorsers_per_block - ?with_commitments - ?(initial_balances = []) - ?initial_endorsers - ?min_proposal_quorum - n = - let accounts = Account.generate_accounts ~initial_balances n in - let contracts = List.map (fun (a, _) -> - Alpha_context.Contract.implicit_contract Account.(a.pkh)) accounts in - Block.genesis - ?endorsers_per_block - ?with_commitments - ?initial_endorsers - ?min_proposal_quorum - accounts >>=? fun blk -> - return (blk, contracts) diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/context.mli b/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/context.mli deleted file mode 100644 index 28805d0d1..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/context.mli +++ /dev/null @@ -1,119 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol -open Alpha_context -open Environment - -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 -> Alpha_services.Delegate.Endorsing_rights.t list tzresult Lwt.t - -val get_endorser: t -> (public_key_hash * int list) tzresult Lwt.t - -val get_bakers: t -> public_key_hash list tzresult Lwt.t - -val get_seed_nonce_hash: t -> Nonce_hash.t tzresult Lwt.t - -(** Returns the seed of the cycle to which the block belongs to. *) -val get_seed: t -> Seed.seed tzresult Lwt.t - -(** Returns all the constants of the protocol *) -val get_constants: t -> Constants.t tzresult Lwt.t - -val get_minimal_valid_time: t -> priority:int -> endorsing_power:int -> Time.t tzresult Lwt.t - -val get_baking_reward: t -> priority:int -> endorsing_power:int -> Tez.t tzresult Lwt.t - -val get_endorsing_reward: t -> priority:int -> endorsing_power:int -> Tez.t tzresult Lwt.t - -module Vote : sig - val get_ballots: t -> Vote.ballots tzresult Lwt.t - val get_ballot_list: t -> (Signature.Public_key_hash.t * Vote.ballot) list tzresult Lwt.t - val get_voting_period: t -> Voting_period.t tzresult Lwt.t - val get_voting_period_position: t -> Int32.t tzresult Lwt.t - val get_current_period_kind: t -> Voting_period.kind tzresult Lwt.t - val get_current_quorum: t -> Int32.t tzresult Lwt.t - val get_participation_ema: Block.t -> Int32.t tzresult Lwt.t - val get_listings: t -> (Signature.Public_key_hash.t * int32) list tzresult Lwt.t - val get_proposals: t -> Int32.t Protocol_hash.Map.t tzresult Lwt.t - val get_current_proposal: t -> Protocol_hash.t option tzresult Lwt.t - val get_protocol : Block.t -> Protocol_hash.t Lwt.t - val set_participation_ema : Block.t -> int32 -> Block.t Lwt.t -end - -module Contract : sig - - val pp : Format.formatter -> Contract.t -> unit - 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 or rewards. *) - val balance: ?kind:balance_kind -> t -> Contract.t -> Tez.t tzresult Lwt.t - - val counter: t -> Contract.t -> Z.t 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 - - val delegate: t -> Contract.t -> public_key_hash tzresult Lwt.t - val delegate_opt: t -> Contract.t -> public_key_hash option tzresult Lwt.t - -end - -module Delegate : sig - - type info = Delegate_services.info = { - balance: Tez.t ; - frozen_balance: Tez.t ; - frozen_balance_by_cycle: Delegate.frozen_balance Cycle.Map.t ; - staking_balance: Tez.t ; - delegated_contracts: Contract_repr.t list ; - delegated_balance: Tez.t ; - deactivated: bool ; - grace_period: Cycle.t ; - } - - val info: t -> public_key_hash -> Delegate_services.info tzresult Lwt.t - -end - -(** [init n] : returns an initial block with [n] initialized accounts - and the associated implicit contracts *) -val init: - ?endorsers_per_block: int -> - ?with_commitments: bool -> - ?initial_balances: int64 list -> - ?initial_endorsers: int -> - ?min_proposal_quorum: int32 -> - int -> (Block.t * Alpha_context.Contract.t list) tzresult Lwt.t diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/dune b/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/dune deleted file mode 100644 index 164b3df2c..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/dune +++ /dev/null @@ -1,19 +0,0 @@ -(library - (name tezos_005_PsBabyM1_test_helpers) - (public_name tezos-005-PsBabyM1-test-helpers) - (libraries tezos-base - tezos-stdlib-unix - tezos-shell-services - tezos-protocol-environment - tezos-protocol-005-PsBabyM1 - tezos-protocol-005-PsBabyM1-parameters) - (flags (:standard -open Tezos_base__TzPervasives - -open Tezos_micheline - -open Tezos_stdlib_unix - -open Tezos_protocol_005_PsBabyM1 - -open Tezos_shell_services))) - -(alias - (name runtest_lint) - (deps (glob_files *.ml{,i})) - (action (run %{lib:tezos-tooling:lint.sh} %{deps}))) diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/incremental.ml b/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/incremental.ml deleted file mode 100644 index 3365ade0f..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/incremental.ml +++ /dev/null @@ -1,188 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol -open Alpha_context - -type t = { - predecessor: Block.t ; - state: validation_state ; - rev_operations: Operation.packed list ; - rev_tickets: operation_receipt list ; - header: Block_header.t ; - delegate: Account.t ; -} -type incremental = t - -let predecessor { predecessor ; _ } = predecessor -let header { header ; _ } = header -let rev_tickets { rev_tickets ; _ } = rev_tickets -let level st = st.header.shell.level - -let rpc_context st = - let result = Alpha_context.finalize st.state.ctxt in - { - Environment.Updater.block_hash = Block_hash.zero ; - block_header = { st.header.shell with fitness = result.fitness } ; - context = result.context ; - } - -let rpc_ctxt = - new Environment.proto_rpc_context_of_directory - rpc_context rpc_services - -let begin_construction ?(priority=0) ?timestamp ?seed_nonce_hash - ?(policy=Block.By_priority priority) (predecessor : Block.t) = - Block.get_next_baker ~policy - predecessor >>=? fun (delegate, priority, _timestamp) -> - Alpha_services.Delegate.Minimal_valid_time.get - Block.rpc_ctxt predecessor priority 0 >>=? fun real_timestamp -> - Account.find delegate >>=? fun delegate -> - let timestamp = Option.unopt ~default:real_timestamp timestamp in - let contents = Block.Forge.contents ~priority ?seed_nonce_hash () 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 ; - level = predecessor.header.shell.level ; - context = Context_hash.zero ; - operations_hash = Operation_list_list_hash.zero ; - } ; - protocol_data = { - contents ; - signature = Signature.zero ; - } ; - } in - begin_construction - ~chain_id: Chain_id.zero - ~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 -> - Lwt.return (Environment.wrap_error state) - >>=? fun state -> - return { - predecessor ; - state ; - rev_operations = [] ; - rev_tickets = [] ; - header ; - delegate ; - } - -let detect_script_failure : - type kind. kind Apply_results.operation_metadata -> _ = - let rec detect_script_failure : - type kind. kind Apply_results.contents_result_list -> _ = - let open Apply_results in - let detect_script_failure_single - (type kind) - (Manager_operation_result { operation_result ; - internal_operation_results ; _ } - : kind Kind.manager Apply_results.contents_result) = - let detect_script_failure (type kind) (result : kind manager_operation_result) = - match result with - | Applied _ -> Ok () - | Skipped _ -> assert false - | Backtracked (_, None) -> - (* there must be another error for this to happen *) - Ok () - | Backtracked (_, Some errs) -> - Environment.wrap_error (Error errs) - | Failed (_, errs) -> - Environment.wrap_error (Error errs) in - List.fold_left - (fun acc (Internal_operation_result (_, r)) -> - acc >>? fun () -> - detect_script_failure r) - (detect_script_failure operation_result) - internal_operation_results in - function - | Single_result (Manager_operation_result _ as res) -> - detect_script_failure_single res - | Single_result _ -> - Ok () - | Cons_result (res, rest) -> - detect_script_failure_single res >>? fun () -> - detect_script_failure rest in - fun { contents } -> detect_script_failure contents - -let add_operation ?expect_failure st op = - let open Apply_results in - apply_operation st.state op >>= fun x -> - Lwt.return (Environment.wrap_error x) - >>=? function - | state, (Operation_metadata result as metadata) -> - Lwt.return @@ detect_script_failure result >>= fun result -> - begin match expect_failure with - | None -> - Lwt.return result - | Some f -> - match result with - | Ok _ -> - failwith "Error expected while adding operation" - | Error e -> - f e - end >>=? fun () -> - return { st with state ; rev_operations = op :: st.rev_operations ; - rev_tickets = metadata :: st.rev_tickets } - | state, (No_operation_metadata as metadata) -> - return { st with state ; rev_operations = op :: st.rev_operations ; - rev_tickets = metadata :: st.rev_tickets } - -let finalize_block st = - finalize_block st.state >>= fun x -> - Lwt.return (Environment.wrap_error x) - >>=? 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_packed operations) - ] in - let header = - { st.header with - shell = { - st.header.shell with - level = Int32.succ st.header.shell.level ; - operations_hash ; fitness = result.fitness ; - } } in - let hash = Block_header.hash header in - return { - Block.hash ; - header ; - operations ; - context = result.context ; - } diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/incremental.mli b/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/incremental.mli deleted file mode 100644 index e5d95fc33..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/incremental.mli +++ /dev/null @@ -1,51 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol -open Alpha_context - -type t -type incremental = t - -val predecessor: incremental -> Block.t -val header: incremental -> Block_header.t -val rev_tickets: incremental -> operation_receipt list -val level: incremental -> int32 - -val begin_construction: - ?priority:int -> - ?timestamp:Time.Protocol.t -> - ?seed_nonce_hash: Nonce_hash.t -> - ?policy:Block.baker_policy -> - Block.t -> - incremental tzresult Lwt.t - -val add_operation: - ?expect_failure:(error list -> unit tzresult Lwt.t) -> - incremental -> Operation.packed -> incremental tzresult Lwt.t - -val finalize_block: incremental -> Block.t tzresult Lwt.t - -val rpc_ctxt: incremental Environment.RPC_context.simple diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/nonce.ml b/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/nonce.ml deleted file mode 100644 index 7912ecb6f..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/nonce.ml +++ /dev/null @@ -1,33 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2018. *) -(* Dynamic Ledger Solutions, Inc.< contact@tezos.com > *) -(* *) -(* All rights reserved.No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -open Protocol - -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/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/nonce.mli b/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/nonce.mli deleted file mode 100644 index c958bfd36..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/nonce.mli +++ /dev/null @@ -1,31 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol - -(** 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/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/op.ml b/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/op.ml deleted file mode 100644 index 33c6648f6..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/op.ml +++ /dev/null @@ -1,337 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol -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_list contents) in - let signature = Some (Signature.sign ~watermark sk unsigned) in - ({ shell = { branch } ; - protocol_data = { - contents ; - signature ; - } ; - } : _ Operation.t) - -let endorsement ?delegate ?level ctxt ?(signing_context = ctxt) () = - begin - match delegate with - | None -> - Context.get_endorser ctxt >>=? fun (delegate, _slots) -> - return delegate - | 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 = Single (Endorsement { level }) in - return (sign ~watermark:Signature.(Endorsement Chain_id.zero) delegate.sk signing_context op) - -let sign ?watermark sk ctxt (Contents_list contents) = - Operation.pack (sign ?watermark sk ctxt contents) - -let combine_operations - ?public_key - ?counter - ~source ctxt - (packed_operations : packed_operation list) = - assert (List.length packed_operations > 0); - (* Hypothesis : each operation must have the same branch (is this really true?) *) - let { Tezos_base.Operation.branch } = (List.hd packed_operations).shell in - assert (List.for_all - (fun { shell = { Tezos_base.Operation.branch = b ; _} ; _} -> Block_hash.(branch = b)) - packed_operations) ; - (* TODO? : check signatures consistency *) - let unpacked_operations = - List.map (function - | ({ Alpha_context.protocol_data = Operation_data { contents ; _ } ; _ } ) -> - match Contents_list contents with - | Contents_list (Single o) -> Contents o - | Contents_list (Cons - ((Manager_operation { operation = Reveal _ ; _ }) - , (Single o))) -> Contents o - | _ -> (* TODO : decent error *) assert false - ) packed_operations in - begin match counter with - | Some counter -> return counter - | None -> Context.Contract.counter ctxt source - end >>=? fun counter -> - (* We increment the counter *) - let counter = Z.succ counter in - Context.Contract.manager ctxt source >>=? fun account -> - let public_key = Option.unopt ~default:account.pk public_key in - begin Context.Contract.is_manager_key_revealed ctxt source >>=? function - | false -> - let reveal_op = Manager_operation { - source = Signature.Public_key.hash public_key ; - fee = Tez.zero ; - counter ; - operation = Reveal public_key ; - gas_limit = Z.of_int 10000 ; - storage_limit = Z.zero ; - } in - return (Some (Contents reveal_op), Z.succ counter) - | true -> return (None, counter) - end >>=? fun (manager_op, counter) -> - (* Update counters and transform into a contents_list *) - let operations = - List.fold_left (fun (counter, acc) -> function - | Contents (Manager_operation m) -> - (Z.succ counter, - (Contents (Manager_operation { m with counter }) :: acc)) - | x -> counter, x :: acc) - (counter, (match manager_op with - | None -> [] - | Some op -> [ op ])) - unpacked_operations - |> snd |> List.rev - in - - let operations = Operation.of_list operations in - return @@ sign account.sk ctxt operations - -let manager_operation - ?counter - ?(fee = Tez.zero) - ?(gas_limit) - ?(storage_limit) - ?public_key ~source ctxt operation = - begin match counter with - | Some counter -> return counter - | None -> Context.Contract.counter ctxt source end - >>=? fun counter -> - Context.get_constants ctxt >>=? fun c -> - let gas_limit = Option.unopt - ~default:c.parametric.hard_storage_limit_per_operation gas_limit in - let storage_limit = Option.unopt - ~default:c.parametric.hard_storage_limit_per_operation storage_limit in - Context.Contract.manager ctxt source >>=? fun account -> - let public_key = Option.unopt ~default:account.pk public_key in - let counter = Z.succ counter in - Context.Contract.is_manager_key_revealed ctxt source >>=? function - | true -> - let op = - Manager_operation { - source = Signature.Public_key.hash public_key ; - fee ; - counter ; - operation ; - gas_limit ; - storage_limit ; - } in - return (Contents_list (Single op)) - | false -> - let op_reveal = - Manager_operation { - source = Signature.Public_key.hash public_key; - fee = Tez.zero ; - counter ; - operation = Reveal public_key ; - gas_limit = Z.of_int 10000 ; - storage_limit = Z.zero ; - } in - let op = - Manager_operation { - source = Signature.Public_key.hash public_key ; - fee ; - counter = Z.succ counter ; - operation ; - gas_limit ; - storage_limit ; - } in - return (Contents_list (Cons (op_reveal, Single op))) - -let revelation ctxt public_key = - let pkh = Signature.Public_key.hash public_key in - let source = Contract.implicit_contract pkh in - Context.Contract.counter ctxt source >>=? fun counter -> - Context.Contract.manager ctxt source >>=? fun account -> - let counter = Z.succ counter in - let sop = - Contents_list - (Single - (Manager_operation { - source = Signature.Public_key.hash public_key ; - fee = Tez.zero ; - counter ; - operation = Reveal public_key ; - gas_limit = Z.of_int 10000 ; - storage_limit = Z.zero ; - })) in - return @@ sign account.sk ctxt sop - -let originated_contract op = - let nonce = Contract.initial_origination_nonce (Operation.hash_packed op) in - Contract.originated_contract nonce - -exception Impossible - -let origination ?counter ?delegate ~script - ?(preorigination = None) - ?public_key ?credit ?fee ?gas_limit ?storage_limit ctxt source = - Context.Contract.manager ctxt source >>=? fun account -> - 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 operation = - Origination { - delegate ; - script ; - credit ; - preorigination ; - } in - manager_operation ?counter ?public_key ?fee ?gas_limit ?storage_limit - ~source ctxt operation >>=? fun sop -> - let op = sign account.sk ctxt sop in - return (op , originated_contract op) - -let miss_signed_endorsement ?level ctxt = - begin - match level with - | None -> Context.get_level ctxt - | Some level -> return level - end >>=? fun level -> - Context.get_endorser ctxt >>=? fun (real_delegate_pkh, _slots) -> - let delegate = Account.find_alternate real_delegate_pkh in - endorsement ~delegate:delegate.pkh ~level ctxt () - -let transaction ?fee ?gas_limit ?storage_limit ?(parameters = Script.unit_parameter) ?(entrypoint = "default") ctxt - (src:Contract.t) (dst:Contract.t) - (amount:Tez.t) = - let top = Transaction { - amount; - parameters; - destination=dst; - entrypoint; - } in - manager_operation ?fee ?gas_limit ?storage_limit - ~source:src ctxt top >>=? fun sop -> - 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_operation ?fee ~source ctxt top >>=? fun sop -> - 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 = - Single (Activate_account { id ; activation_code } ) in - let branch = Context.branch ctxt in - return { - shell = { branch } ; - protocol_data = Operation_data { - contents ; - signature = None ; - } ; - } - -let double_endorsement ctxt op1 op2 = - let contents = - Single (Double_endorsement_evidence {op1 ; op2}) in - let branch = Context.branch ctxt in - return { - shell = { branch } ; - protocol_data = Operation_data { - contents ; - signature = None ; - } ; - } - -let double_baking ctxt bh1 bh2 = - let contents = - Single (Double_baking_evidence {bh1 ; bh2}) in - let branch = Context.branch ctxt in - return { - shell = { branch } ; - protocol_data = Operation_data { - contents ; - signature = None ; - } ; - } - -let seed_nonce_revelation ctxt level nonce = - return - { shell = { branch = Context.branch ctxt } ; - protocol_data = Operation_data { - contents = Single (Seed_nonce_revelation { level ; nonce }) ; - signature = None ; - } ; - } - -let proposals ctxt (pkh: Contract.t) proposals = - Context.Contract.pkh pkh >>=? fun source -> - Context.Vote.get_voting_period ctxt >>=? fun period -> - let op = - Proposals { source ; - period ; - proposals } in - Account.find source >>=? fun account -> - return (sign account.sk ctxt (Contents_list (Single op))) - -let ballot ctxt (pkh: Contract.t) proposal ballot = - Context.Contract.pkh pkh >>=? fun source -> - Context.Vote.get_voting_period ctxt >>=? fun period -> - let op = - Ballot { source ; - period ; - proposal ; - ballot - } in - Account.find source >>=? fun account -> - return (sign account.sk ctxt (Contents_list (Single op))) - -let dummy_script = - let open Micheline in - Script.({ - code = lazy_expr (strip_locations (Seq (0, [ - Prim (0, K_parameter, [Prim (0, T_unit, [], [])], []) ; - Prim (0, K_storage, [Prim (0, T_unit, [], [])], []) ; - Prim (0, K_code, [ - Seq (0, [ - Prim (0, I_CDR, [], []) ; - Prim (0, I_NIL, [Prim (0, T_operation, [], [])], []) ; - Prim (0, I_PAIR, [], []) ; - ])], []) ; - ]))) ; - storage = lazy_expr (strip_locations (Prim (0, D_Unit, [], []))) ; - }) - -let dummy_script_cost = Test_tez.Tez.of_mutez_exn 38_000L diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/op.mli b/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/op.mli deleted file mode 100644 index 743a11220..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/op.mli +++ /dev/null @@ -1,114 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol -open Alpha_context - -val endorsement: - ?delegate:public_key_hash -> - ?level:Raw_level.t -> - Context.t -> ?signing_context:Context.t -> unit -> - Kind.endorsement Operation.t tzresult Lwt.t - -val miss_signed_endorsement: - ?level:Raw_level.t -> - Context.t -> Kind.endorsement Operation.t tzresult Lwt.t - -val transaction: - ?fee:Tez.tez -> - ?gas_limit:Z.t -> - ?storage_limit:Z.t -> - ?parameters:Script.lazy_expr -> - ?entrypoint:string -> - Context.t -> - Contract.t -> - Contract.t -> - Tez.t -> - Operation.packed tzresult Lwt.t - -val delegation: - ?fee:Tez.tez -> Context.t -> - Contract.t -> public_key_hash option -> - Operation.packed tzresult Lwt.t - -val revelation: - Context.t -> public_key -> Operation.packed tzresult Lwt.t - -val origination: - ?counter: Z.t -> - ?delegate:public_key_hash -> - script:Script.t -> - ?preorigination: Contract.contract option -> - ?public_key:public_key -> - ?credit:Tez.tez -> - ?fee:Tez.tez -> - ?gas_limit:Z.t -> - ?storage_limit:Z.t -> - Context.t -> - Contract.contract -> - (Operation.packed * Contract.contract) tzresult Lwt.t - -val originated_contract: - Operation.packed -> Contract.contract - -val double_endorsement: - Context.t -> - Kind.endorsement Operation.t -> - Kind.endorsement Operation.t -> - Operation.packed tzresult Lwt.t - -val double_baking: - Context.t -> - Block_header.block_header -> - Block_header.block_header -> - Operation.packed tzresult Lwt.t - -val activation: - Context.t -> - Signature.Public_key_hash.t -> Blinded_public_key_hash.activation_code -> - Operation.packed tzresult Lwt.t - -val combine_operations : - ?public_key:public_key -> - ?counter:counter -> - source:Contract.t -> - Context.t -> - packed_operation list -> packed_operation tzresult Lwt.t - -(** Reveals a seed_nonce that was previously committed at a certain level *) -val seed_nonce_revelation: - Context.t -> Raw_level.t -> Nonce.t -> Operation.packed tzresult Lwt.t - -(** Propose a list of protocol hashes during the approval voting *) -val proposals : Context.t -> Contract.t -> Protocol_hash.t list -> - Operation.packed tzresult Lwt.t - -(** Cast a vote yay, nay or pass *) -val ballot : Context.t -> - Contract.t -> Protocol_hash.t -> Vote.ballot -> - Operation.packed tzresult Lwt.t - -val dummy_script : Script.t -val dummy_script_cost : Test_tez.Tez.t diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/test_tez.ml b/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/test_tez.ml deleted file mode 100644 index cb3167156..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/test_tez.ml +++ /dev/null @@ -1,61 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol -open Alpha_context -open Environment - -(* 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 ( + ) t1 t2 = - match t1 +? t2 with - | Ok r -> r - | Error _ -> - Pervasives.failwith "adding tez" - - 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 - - let of_mutez_exn x = - match Tez.of_mutez x with - | None -> invalid_arg "tez_of_mutez" - | Some x -> x - - - let max_tez = - match Tez.of_mutez Int64.max_int with - | None -> assert false - | Some p -> p - -end diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/test_utils.ml b/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/test_utils.ml deleted file mode 100644 index e71947bc7..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/test_utils.ml +++ /dev/null @@ -1,43 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -(* This file should not depend on any other file from tests. *) - -let (>>?=) x y = match x with - | Ok(a) -> y a - | Error(b) -> fail @@ List.hd b - -(** 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 - -exception Pair_of_list -let pair_of_list = function - | [a;b] -> a,b - | _ -> raise Pair_of_list diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/tezos-005-PsBabyM1-test-helpers.opam b/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/tezos-005-PsBabyM1-test-helpers.opam deleted file mode 100644 index 0d8528023..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/helpers/tezos-005-PsBabyM1-test-helpers.opam +++ /dev/null @@ -1,21 +0,0 @@ -opam-version: "2.0" -maintainer: "contact@tezos.com" -authors: [ "Tezos devteam" ] -homepage: "https://www.tezos.com/" -bug-reports: "https://gitlab.com/tezos/tezos/issues" -dev-repo: "git+https://gitlab.com/tezos/tezos.git" -license: "MIT" -depends: [ - "ocamlfind" { build } - "dune" { build & >= "1.7" } - "tezos-base" - "tezos-stdlib-unix" - "tezos-shell-services" - "tezos-protocol-environment" - "tezos-protocol-005-PsBabyM1" - "tezos-protocol-005-PsBabyM1-parameters" -] -build: [ - [ "dune" "build" "-p" name "-j" jobs ] -] -synopsis: "Tezos/Protocol: protocol testing framework" diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/main.ml b/vendors/ligo-utils/tezos-protocol-alpha/test/main.ml deleted file mode 100644 index 4c66e24bb..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/main.ml +++ /dev/null @@ -1,41 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -let () = - Alcotest.run "protocol_005_PsBabyM1" [ - "transfer", Transfer.tests ; - "origination", Origination.tests ; - "activation", Activation.tests ; - "endorsement", Endorsement.tests ; - "double endorsement", Double_endorsement.tests ; - "double baking", Double_baking.tests ; - "seed", Seed.tests ; - "baking", Baking.tests ; - "delegation", Delegation.tests ; - "rolls", Rolls.tests ; - "combined", Combined_operations.tests ; - "qty", Qty.tests ; - "voting", Voting.tests ; - ] diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/origination.ml b/vendors/ligo-utils/tezos-protocol-alpha/test/origination.ml deleted file mode 100644 index c7b2b4281..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/origination.ml +++ /dev/null @@ -1,235 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol -open Test_utils -open Test_tez - -let ten_tez = Tez.of_int 10 - -(** [register_origination fee credit spendable delegatable] takes four - optional parameter: fee for the fee need to be paid if set to - create an originated contract; credit is the amount of tez that - send to this originated contract; spendable default is set to true - meaning that this contract is spendable; delegatable default is - set to true meaning that this contract is able to delegate. *) -let register_origination ?(fee=Tez.zero) ?(credit=Tez.zero) () = - Context.init 1 >>=? fun (b, contracts) -> - let source = List.hd contracts in - Context.Contract.balance (B b) source >>=? fun source_balance -> - Op.origination (B b) source ~fee ~credit ~script:Op.dummy_script - >>=? fun (operation, originated) -> - Block.bake ~operation b >>=? fun b -> - (* fee + credit + block security deposit were debited from source *) - Context.get_constants (B b) >>=? fun {parametric = { origination_size ; - cost_per_byte ; - block_security_deposit ; _ }; _ } -> - Tez.(cost_per_byte *? Int64.of_int origination_size) >>?= fun origination_burn -> - Lwt.return ( - Tez.(+?) credit block_security_deposit >>? - Tez.(+?) fee >>? - Tez.(+?) origination_burn >>? - Tez.(+?) Op.dummy_script_cost ) >>=? fun total_fee -> - Assert.balance_was_debited ~loc:__LOC__ (B b) source source_balance total_fee >>=? fun () -> - (* originated contract has been credited *) - Assert.balance_was_credited ~loc:__LOC__ (B b) originated Tez.zero credit >>=? fun () -> - (* TODO spendable or not and delegatable or not if relevant for some - test. Not the case at the moment, cf. uses of - register_origination *) - return (b, source, originated) - - -(* [test_origination_balances fee credit spendable delegatable] - takes four optional parameter: fee is the fee that pay if require to create - an originated contract; credit is the amount of tez that will send to this - contract; delegatable default is set to true meaning that this contract is - able to delegate. - This function will create a contract, get the balance of this contract, call - the origination operation to create a new originated contract from this - contract with all the possible fees; and check the balance before/after - originated operation valid. - - the source contract has payed all the fees - - the originated has been credited correctly *) -let test_origination_balances ~loc:_ ?(fee=Tez.zero) ?(credit=Tez.zero) () = - Context.init 1 >>=? fun (b, contracts) -> - let contract = List.hd contracts in - Context.Contract.balance (B b) contract >>=? fun balance -> - Op.origination (B b) contract ~fee ~credit ~script:Op.dummy_script - >>=? fun (operation, new_contract) -> - (* The possible fees are: a given credit, an origination burn fee - (constants_repr.default.origination_burn = 257 mtez), - a fee that is paid when creating an originate contract. - - We also take into account a block security deposit. Note that it - is not related to origination but to the baking done in the - tests.*) - Context.get_constants (B b) >>=? fun - { parametric = - { origination_size ; - cost_per_byte ; - block_security_deposit - ; _ } - ; _ } -> - Tez.(cost_per_byte *? Int64.of_int origination_size) >>?= fun origination_burn -> - Lwt.return ( - Tez.(+?) credit block_security_deposit >>? - Tez.(+?) fee >>? - Tez.(+?) origination_burn >>? - Tez.(+?) Op.dummy_script_cost ) >>=? fun total_fee -> - Block.bake ~operation b >>=? fun b -> - (* check that after the block has been baked the source contract - was debited all the fees *) - Assert.balance_was_debited ~loc:__LOC__ (B b) contract balance total_fee - >>=? fun _ -> - (* check the balance of the originate contract is equal to credit *) - Assert.balance_is ~loc:__LOC__ (B b) new_contract credit - -(******************************************************) -(** Tests *) -(******************************************************) - -(** compute half of the balance and divided it by nth times *) - -let two_nth_of_balance incr contract nth = - Context.Contract.balance (I incr) contract >>=? fun balance -> - Tez.(/?) balance nth >>?= fun res -> - Tez.( *?) res 2L >>?= fun balance -> - return balance - -(*******************) -(** Basic test *) -(*******************) - -let balances_simple () = test_origination_balances ~loc:__LOC__ () - -let balances_credit () = - test_origination_balances ~loc:__LOC__ ~credit:ten_tez () - -let balances_credit_fee () = - test_origination_balances ~loc:__LOC__ ~credit:(Tez.of_int 2) ~fee:ten_tez () - -let balances_undelegatable () = - test_origination_balances ~loc:__LOC__ () - -(*******************) -(** ask source contract to pay a fee when originating a contract *) -(*******************) - -let pay_fee () = - register_origination ~credit:(Tez.of_int 2) ~fee:ten_tez () >>=? fun (_b, _contract, _new_contract) -> - return_unit - -(******************************************************) -(** Errors *) -(******************************************************) - -(*******************) -(** create an originate contract where the contract - does not have enough tez to pay for the fee *) -(*******************) - -let not_tez_in_contract_to_pay_fee () = - Context.init 2 >>=? fun (b, contracts) -> - let contract_1 = List.nth contracts 0 in - let contract_2 = List.nth contracts 1 in - Incremental.begin_construction b >>=? fun inc -> - (* transfer everything but one tez from 1 to 2 and check balance of 1 *) - Context.Contract.balance (I inc) contract_1 >>=? fun balance -> - Lwt.return @@ Tez.(-?) balance Tez.one >>=? fun amount -> - Op.transaction (I inc) contract_1 contract_2 amount >>=? fun operation -> - Incremental.add_operation inc operation >>=? fun inc -> - Assert.balance_was_debited ~loc:__LOC__ (I inc) contract_1 balance amount - >>=? fun _ -> - (* use this source contract to create an originate contract where it requires - to pay a fee and add an amount of credit into this new contract *) - Op.origination (I inc) ~fee:ten_tez ~credit:Tez.one contract_1 ~script:Op.dummy_script >>=? fun (op, _) -> - Incremental.add_operation inc op >>= fun inc -> - Assert.proto_error ~loc:__LOC__ inc begin function - | Contract_storage.Balance_too_low _ -> true - | _ -> false - end - -(***************************************************) -(* set the endorser of the block as manager/delegate of the originated - account *) -(***************************************************) - -let register_contract_get_endorser () = - Context.init 1 >>=? fun (b, contracts) -> - let contract = List.hd contracts in - Incremental.begin_construction b >>=? fun inc -> - Context.get_endorser (I inc) >>=? fun (account_endorser, _slots) -> - return (inc, contract, account_endorser) - -(*******************) -(** create multiple originated contracts and - ask contract to pay the fee *) -(*******************) - -let n_originations n ?credit ?fee () = - fold_left_s (fun new_contracts _ -> - register_origination ?fee ?credit () >>=? fun (_b, _source, new_contract) -> - - let contracts = new_contract :: new_contracts in - return contracts - ) [] (1 -- n) - -let multiple_originations () = - n_originations 100 ~credit:(Tez.of_int 2) ~fee:ten_tez () >>=? fun contracts -> - Assert.equal_int ~loc:__LOC__ (List.length contracts) 100 - -(*******************) -(** cannot originate two contracts with the same context's counter *) -(*******************) - -let counter () = - Context.init 1 >>=? fun (b, contracts) -> - let contract = List.hd contracts in - Incremental.begin_construction b >>=? fun inc -> - Op.origination (I inc) ~credit:Tez.one contract ~script:Op.dummy_script >>=? fun (op1, _) -> - Op.origination (I inc) ~credit:Tez.one contract ~script:Op.dummy_script >>=? fun (op2, _) -> - Incremental.add_operation inc op1 >>=? fun inc -> - Incremental.add_operation inc op2 >>= fun res -> - Assert.proto_error ~loc:__LOC__ res begin function - | Contract_storage.Counter_in_the_past _ -> true - | _ -> false - end - -(******************************************************) - -let tests = [ - Test.tztest "balances_simple" `Quick balances_simple ; - Test.tztest "balances_credit" `Quick balances_credit ; - Test.tztest "balances_credit_fee" `Quick balances_credit_fee ; - Test.tztest "balances_undelegatable" `Quick balances_undelegatable ; - - Test.tztest "pay_fee" `Quick pay_fee; - - Test.tztest "not enough tez in contract to pay fee" `Quick not_tez_in_contract_to_pay_fee; - - Test.tztest "multiple originations" `Quick multiple_originations; - - Test.tztest "counter" `Quick counter; -] diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/qty.ml b/vendors/ligo-utils/tezos-protocol-alpha/test/qty.ml deleted file mode 100644 index 6c5c1fd0b..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/qty.ml +++ /dev/null @@ -1,141 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol - -let known_ok_tez_literals = - [ 0L, "0" ; - 10L, "0.00001" ; - 100L, "0.0001" ; - 1_000L, "0.001" ; - 10_000L, "0.01" ; - 100_000L, "0.1" ; - 1_000_000L, "1" ; - 10_000_000L, "10" ; - 100_000_000L, "100" ; - 1_000_000_000L, "1000" ; - 10_000_000_000L, "10000" ; - 100_000_000_000L, "100000" ; - 1_000_000_000_000L, "1000000" ; - 1_000_000_000_001L, "1000000.000001" ; - 1_000_000_000_010L, "1000000.00001" ; - 1_000_000_000_100L, "1000000.0001" ; - 1_000_000_001_000L, "1000000.001" ; - 1_000_000_010_000L, "1000000.01" ; - 1_000_000_100_000L, "1000000.1" ; - 123_123_123_123_123_123L, "123123123123.123123" ; - 999_999_999_999_999_999L, "999999999999.999999" ] - -let known_bad_tez_literals = - [ "10000." ; - "100,." ; - "100," ; - "1,0000" ; - "0.0000,1" ; - "0.00,1" ; - "0,1" ; - "HAHA" ; - "0.000,000,1" ; - "0.0000000" ; - "9,999,999,999,999.999,999"] - -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_none ?(msg="") x = - if x <> None then fail "None" "Some _" msg - -let is_some ?(msg="") x = - if x = None then fail "Some _" "None" msg - -let test_known_tez_literals () = - List.iter - (fun (v, s) -> - let vv = Tez_repr.of_mutez v in - let vs = Tez_repr.of_string s in - let vs' = Tez_repr.of_string (String.concat "" (String.split_on_char ',' s)) in - let vv = match vv with None -> fail_msg "could not unopt %Ld" v | Some vv -> vv in - let vs = match vs with None -> fail_msg "could not unopt %s" s | Some vs -> vs in - let vs' = match vs' with None -> fail_msg "could not unopt %s" s | Some vs' -> vs' in - - equal ~prn:Tez_repr.to_string vv vs ; - equal ~prn:Tez_repr.to_string vv vs' ; - equal ~prn:(fun s -> s) (Tez_repr.to_string vv) s) - known_ok_tez_literals ; - List.iter - (fun s -> - let vs = Tez_repr.of_string s in - is_none ~msg:("Unexpected successful parsing of " ^ s) vs) - known_bad_tez_literals ; - return_unit - -let test_random_tez_literals () = - for _ = 0 to 100_000 do - let v = Random.int64 12L in - let vv = Tez_repr.of_mutez v in - let vv = match vv with None -> fail_msg "could not unopt %Ld" v | Some vv -> vv in - let s = Tez_repr.to_string vv in - let vs = Tez_repr.of_string s in - let s' = String.concat "" (String.split_on_char ',' s) in - let vs' = Tez_repr.of_string s' in - is_some ~msg:("Could not parse " ^ s ^ " back") vs ; - is_some ~msg:("Could not parse " ^ s ^ " back") vs' ; - begin match vs with - | None -> assert false - | Some vs -> - let rev = Tez_repr.to_int64 vs in - equal ~prn:Int64.to_string ~msg:(Tez_repr.to_string vv) v rev - end ; - begin match vs' with - | None -> assert false - | Some vs' -> - let rev = Tez_repr.to_int64 vs' in - equal ~prn:Int64.to_string ~msg:(Tez_repr.to_string vv) v rev - end - done ; - return_unit - -let tests = [ - "tez-literals", (fun _ -> test_known_tez_literals ()) ; - "rnd-tez-literals", (fun _ -> test_random_tez_literals ()) ; -] - -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" pp_print_error error - end - -let tests = List.map wrap tests diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/rolls.ml b/vendors/ligo-utils/tezos-protocol-alpha/test/rolls.ml deleted file mode 100644 index 9053c31dc..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/rolls.ml +++ /dev/null @@ -1,250 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol -open Alpha_context -open Test_tez -open Test_utils - -let account_pair = function - | [a1; a2] -> (a1, a2) - | _ -> assert false - -let wrap e = Lwt.return (Environment.wrap_error e) -let traverse_rolls ctxt head = - let rec loop acc roll = - Storage.Roll.Successor.get_option ctxt roll >>= wrap >>=? function - | None -> return (List.rev acc) - | Some next -> loop (next :: acc) next in - loop [head] head - -let get_rolls ctxt delegate = - Storage.Roll.Delegate_roll_list.get_option ctxt delegate >>= wrap >>=? function - | None -> return_nil - | Some head_roll -> traverse_rolls ctxt head_roll - -let check_rolls b (account:Account.t) = - Context.get_constants (B b) >>=? fun constants -> - Context.Delegate.info (B b) account.pkh >>=? fun { staking_balance ; _ } -> - let token_per_roll = constants.parametric.tokens_per_roll in - let expected_rolls = Int64.div (Tez.to_mutez staking_balance) (Tez.to_mutez token_per_roll) in - Raw_context.prepare b.context - ~level:b.header.shell.level - ~predecessor_timestamp:b.header.shell.timestamp - ~timestamp:b.header.shell.timestamp - ~fitness:b.header.shell.fitness >>= wrap >>=? fun ctxt -> - get_rolls ctxt account.pkh >>=? fun rolls -> - Assert.equal_int ~loc:__LOC__ (List.length rolls) (Int64.to_int expected_rolls) - -let check_no_rolls (b : Block.t) (account:Account.t) = - Raw_context.prepare b.context - ~level:b.header.shell.level - ~predecessor_timestamp:b.header.shell.timestamp - ~timestamp:b.header.shell.timestamp - ~fitness:b.header.shell.fitness >>= wrap >>=? fun ctxt -> - get_rolls ctxt account.pkh >>=? fun rolls -> - Assert.equal_int ~loc:__LOC__ (List.length rolls) 0 - -let simple_staking_rights () = - Context.init 2 >>=? fun (b,accounts) -> - let (a1, _a2) = account_pair accounts in - - Context.Contract.balance (B b) a1 >>=? fun balance -> - Context.Contract.manager (B b) a1 >>=? fun m1 -> - - Context.Delegate.info (B b) m1.pkh >>=? fun info -> - Assert.equal_tez ~loc:__LOC__ balance info.staking_balance >>=? fun () -> - check_rolls b m1 - -let simple_staking_rights_after_baking () = - Context.init 2 >>=? fun (b,accounts) -> - let (a1, a2) = account_pair accounts in - - Context.Contract.balance (B b) a1 >>=? fun balance -> - Context.Contract.manager (B b) a1 >>=? fun m1 -> - Context.Contract.manager (B b) a2 >>=? fun m2 -> - - Block.bake_n ~policy:(By_account m2.pkh) 5 b >>=? fun b -> - - Context.Delegate.info (B b) m1.pkh >>=? fun info -> - Assert.equal_tez ~loc:__LOC__ balance info.staking_balance >>=? fun () -> - check_rolls b m1 >>=? fun () -> - check_rolls b m2 - -let frozen_deposit (info:Context.Delegate.info) = - Cycle.Map.fold (fun _ { Delegate.deposit ; _ } acc -> - Test_tez.Tez.(deposit + acc)) - info.frozen_balance_by_cycle Tez.zero - -let check_activate_staking_balance ~loc ~deactivated b (a, (m:Account.t)) = - Context.Delegate.info (B b) m.pkh >>=? fun info -> - Assert.equal_bool ~loc info.deactivated deactivated >>=? fun () -> - Context.Contract.balance (B b) a >>=? fun balance -> - let deposit = frozen_deposit info in - Assert.equal_tez ~loc Test_tez.Tez.(balance + deposit) info.staking_balance - -let run_until_deactivation () = - Context.init 2 >>=? fun (b,accounts) -> - let (a1, a2) = account_pair accounts in - - Context.Contract.balance (B b) a1 >>=? fun balance_start -> - Context.Contract.manager (B b) a1 >>=? fun m1 -> - Context.Contract.manager (B b) a2 >>=? fun m2 -> - - check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b (a1,m1) >>=? fun () -> - - Context.Delegate.info (B b) m1.pkh >>=? fun info -> - Block.bake_until_cycle ~policy:(By_account m2.pkh) info.grace_period b >>=? fun b -> - - check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b (a1,m1) >>=? fun () -> - - Block.bake_until_cycle_end ~policy:(By_account m2.pkh) b >>=? fun b -> - - check_activate_staking_balance ~loc:__LOC__ ~deactivated:true b (a1,m1) >>=? fun () -> - return (b, ((a1, m1), balance_start), (a2, m2)) - -let deactivation_then_bake () = - run_until_deactivation () >>=? - fun (b, ((_deactivated_contract, deactivated_account) as deactivated, _start_balance), - (_a2, _m2)) -> - - Block.bake ~policy:(By_account deactivated_account.pkh) b >>=? fun b -> - - check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b deactivated >>=? fun () -> - check_rolls b deactivated_account - -let deactivation_then_self_delegation () = - run_until_deactivation () >>=? - fun (b, ((deactivated_contract, deactivated_account) as deactivated, start_balance), - (_a2, m2)) -> - - Op.delegation (B b) deactivated_contract (Some deactivated_account.pkh) >>=? fun self_delegation -> - - Block.bake ~policy:(By_account m2.pkh) b ~operation:self_delegation >>=? fun b -> - - check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b deactivated >>=? fun () -> - Context.Contract.balance (B b) deactivated_contract >>=? fun balance -> - Assert.equal_tez ~loc:__LOC__ start_balance balance >>=? fun () -> - check_rolls b deactivated_account - -let deactivation_then_empty_then_self_delegation () = - run_until_deactivation () >>=? - fun (b, ((deactivated_contract, deactivated_account) as deactivated, _start_balance), - (_a2, m2)) -> - (* empty the contract *) - Context.Contract.balance (B b) deactivated_contract >>=? fun balance -> - let sink_account = Account.new_account () in - let sink_contract = Contract.implicit_contract sink_account.pkh in - Context.get_constants (B b) >>=? fun { parametric = { origination_size ; cost_per_byte ; _ } ; _ } -> - Tez.(cost_per_byte *? Int64.of_int origination_size) >>?= fun origination_burn -> - let amount = match Tez.(balance -? origination_burn) with Ok r -> r | Error _ -> assert false in - Op.transaction (B b) deactivated_contract sink_contract amount >>=? fun empty_contract -> - Block.bake ~policy:(By_account m2.pkh) ~operation:empty_contract b >>=? fun b -> - (* self delegation *) - Op.delegation (B b) deactivated_contract (Some deactivated_account.pkh) >>=? fun self_delegation -> - Block.bake ~policy:(By_account m2.pkh) ~operation:self_delegation b >>=? fun b -> - - check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b deactivated >>=? fun () -> - Context.Contract.balance (B b) deactivated_contract >>=? fun balance -> - Assert.equal_tez ~loc:__LOC__ Tez.zero balance >>=? fun () -> - check_rolls b deactivated_account - -let deactivation_then_empty_then_self_delegation_then_recredit () = - run_until_deactivation () >>=? - fun (b, ((deactivated_contract, deactivated_account) as deactivated, balance), - (_a2, m2)) -> - (* empty the contract *) - let sink_account = Account.new_account () in - let sink_contract = Contract.implicit_contract sink_account.pkh in - Context.get_constants (B b) >>=? fun { parametric = { origination_size ; cost_per_byte ; _ } ; _ } -> - Tez.(cost_per_byte *? Int64.of_int origination_size) >>?= fun origination_burn -> - let amount = match Tez.(balance -? origination_burn) with Ok r -> r | Error _ -> assert false in - Op.transaction (B b) deactivated_contract sink_contract amount >>=? fun empty_contract -> - Block.bake ~policy:(By_account m2.pkh) ~operation:empty_contract b >>=? fun b -> - (* self delegation *) - Op.delegation (B b) deactivated_contract (Some deactivated_account.pkh) >>=? fun self_delegation -> - Block.bake ~policy:(By_account m2.pkh) ~operation:self_delegation b >>=? fun b -> - (* recredit *) - Op.transaction (B b) sink_contract deactivated_contract amount >>=? fun recredit_contract -> - Block.bake ~policy:(By_account m2.pkh) ~operation:recredit_contract b >>=? fun b -> - - check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b deactivated >>=? fun () -> - Context.Contract.balance (B b) deactivated_contract >>=? fun balance -> - Assert.equal_tez ~loc:__LOC__ amount balance >>=? fun () -> - check_rolls b deactivated_account - -let delegation () = - Context.init 2 >>=? fun (b,accounts) -> - let (a1, a2) = account_pair accounts in - let m3 = Account.new_account () in - Account.add_account m3; - - Context.Contract.manager (B b) a1 >>=? fun m1 -> - Context.Contract.manager (B b) a2 >>=? fun m2 -> - let a3 = Contract.implicit_contract m3.pkh in - - Context.Contract.delegate_opt (B b) a1 >>=? fun delegate -> - begin - match delegate with - | None -> assert false - | Some pkh -> - assert (Signature.Public_key_hash.equal pkh m1.pkh) - end; - - Op.transaction (B b) a1 a3 Tez.fifty_cents >>=? fun transact -> - - Block.bake ~policy:(By_account m2.pkh) b ~operation:transact >>=? fun b -> - - Context.Contract.delegate_opt (B b) a3 >>=? fun delegate -> - begin - match delegate with - | None -> () - | Some _ -> assert false - end; - check_no_rolls b m3 >>=? fun () -> - - Op.delegation (B b) a3 (Some m3.pkh) >>=? fun delegation -> - Block.bake ~policy:(By_account m2.pkh) b ~operation:delegation >>=? fun b -> - - Context.Contract.delegate_opt (B b) a3 >>=? fun delegate -> - begin - match delegate with - | None -> assert false - | Some pkh -> - assert (Signature.Public_key_hash.equal pkh m3.pkh) - end; - check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b (a3,m3) >>=? fun () -> - check_rolls b m3 >>=? fun () -> - check_rolls b m1 - -let tests = [ - Test.tztest "simple staking rights" `Quick (simple_staking_rights) ; - Test.tztest "simple staking rights after baking" `Quick (simple_staking_rights_after_baking) ; - Test.tztest "deactivation then bake" `Quick (deactivation_then_bake) ; - Test.tztest "deactivation then self delegation" `Quick (deactivation_then_self_delegation) ; - Test.tztest "deactivation then empty then self delegation" `Quick (deactivation_then_empty_then_self_delegation) ; - Test.tztest "deactivation then empty then self delegation then recredit" `Quick (deactivation_then_empty_then_self_delegation_then_recredit) ; - Test.tztest "delegation" `Quick (delegation) ; -] diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/seed.ml b/vendors/ligo-utils/tezos-protocol-alpha/test/seed.ml deleted file mode 100644 index 63872ad92..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/seed.ml +++ /dev/null @@ -1,223 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -(** Tests about - - seed_nonce_hash included in some blocks - - revelation operation of seed_nonce that should correspond to each - seed_nonce_hash -*) - -open Protocol -open Test_tez - -(** Tests that baking [blocks_per_commitment] blocks without a - [seed_nonce_hash] commitment fails with [Invalid_commitment] *) -let no_commitment () = - Context.init 5 >>=? fun (b,_) -> - Context.get_constants (B b) >>=? fun { parametric = { blocks_per_commitment ; _ } ; _ } -> - let blocks_per_commitment = Int32.to_int blocks_per_commitment in - - (* Bake normally until before the commitment *) - Block.bake_n (blocks_per_commitment-2) b >>=? fun b -> - - (* Forge a block with empty commitment and apply it *) - Block.Forge.forge_header b >>=? fun header -> - Block.Forge.set_seed_nonce_hash None header |> - Block.Forge.sign_header >>=? fun header -> - Block.apply header b >>= fun e -> - - Assert.proto_error ~loc:__LOC__ e begin function - | Apply.Invalid_commitment _ -> true - | _ -> false - end - -let baking_reward ctxt (b: Block.t) = - let priority = b.header.protocol_data.contents.priority in - Block.get_endorsing_power b >>=? fun endorsing_power -> - Context.get_baking_reward ctxt ~priority ~endorsing_power - - -(** Choose a baker, denote it by id. In the first cycle, make id bake only once. - Test that: - - after id bakes with a commitment the bond is frozen and the reward allocated - - when id reveals the nonce too early, there's an error - - when id reveals at the right time but the wrong value, there's an error - - when another baker reveals correctly, it receives the tip - - revealing twice produces an error - - after [preserved cycles] a committer that correctly revealed - receives back the bond and the reward -*) -let revelation_early_wrong_right_twice () = - let open Assert in - - Context.init 5 >>=? fun (b,_) -> - Context.get_constants (B b) >>=? fun csts -> - let bond = csts.parametric.block_security_deposit in - let tip = csts.parametric.seed_nonce_revelation_tip in - let blocks_per_commitment = Int32.to_int csts.parametric.blocks_per_commitment in - let preserved_cycles = csts.parametric.preserved_cycles in - - (* get the pkh of a baker *) - Block.get_next_baker b >>=? fun (pkh,_,_) -> - let id = Alpha_context.Contract.implicit_contract pkh in - let policy = Block.Excluding [pkh] in - (* bake until commitment, excluding id *) - Block.bake_n ~policy (blocks_per_commitment-2) b >>=? fun b -> - Context.Contract.balance ~kind:Main (B b) id >>=? fun bal_main -> - Context.Contract.balance ~kind:Deposit (B b) id >>=? fun bal_deposit -> - Context.Contract.balance ~kind:Rewards (B b) id >>=? fun bal_rewards -> - - (* the baker [id] will include a seed_nonce commitment *) - Block.bake ~policy:(Block.By_account pkh) b >>=? fun b -> - Context.get_level (B b) >>=? fun level_commitment -> - Context.get_seed_nonce_hash (B b) >>=? fun committed_hash -> - baking_reward (B b) b >>=? fun reward -> - - (* test that the bond was frozen and the reward allocated *) - balance_was_debited ~loc:__LOC__ - (B b) id bal_main bond >>=? fun () -> - balance_was_credited ~loc:__LOC__ - (B b) id ~kind:Deposit bal_deposit bond >>=? fun () -> - balance_was_credited ~loc:__LOC__ - (B b) id ~kind:Rewards bal_rewards reward >>=? fun () -> - - (* test that revealing too early produces an error *) - Op.seed_nonce_revelation (B b) level_commitment (Nonce.get committed_hash) >>=? fun operation -> - - Block.bake ~policy ~operation b >>= fun e -> - let expected = function - | Nonce_storage.Too_early_revelation -> true - | _ -> false in - Assert.proto_error ~loc:__LOC__ e expected >>=? fun () -> - - (* finish the cycle excluding the committing baker, id *) - Block.bake_until_cycle_end ~policy b >>=? fun b -> - - (* test that revealing at the right time but the wrong value produces an error *) - let wrong_hash,_ = Nonce.generate () in - Op.seed_nonce_revelation (B b) level_commitment (Nonce.get wrong_hash) >>=? fun operation -> - Block.bake ~operation b >>= fun e -> - Assert.proto_error ~loc:__LOC__ e begin function - | Nonce_storage.Unexpected_nonce -> true - | _ -> false - end >>=? fun () -> - - (* reveals correctly *) - Op.seed_nonce_revelation (B b) level_commitment (Nonce.get committed_hash) >>=? fun operation -> - Block.get_next_baker ~policy b >>=? fun (baker_pkh,_,_) -> - let baker = Alpha_context.Contract.implicit_contract baker_pkh in - Context.Contract.balance ~kind:Main (B b) baker >>=? fun baker_bal_main -> - Context.Contract.balance ~kind:Deposit (B b) baker >>=? fun baker_bal_deposit -> - Context.Contract.balance ~kind:Rewards (B b) baker >>=? fun baker_bal_rewards -> - - (* bake the operation in a block *) - Block.bake ~policy ~operation b >>=? fun b -> - baking_reward (B b) b >>=? fun baker_reward -> - - (* test that the baker gets the tip reward *) - balance_was_debited ~loc:__LOC__ - (B b) baker ~kind:Main baker_bal_main bond >>=? fun () -> - balance_was_credited ~loc:__LOC__ - (B b) baker ~kind:Deposit baker_bal_deposit bond >>=? fun () -> - Lwt.return @@ Tez.(+?) baker_reward tip >>=? fun expected_rewards -> - balance_was_credited ~loc:__LOC__ - (B b) baker ~kind:Rewards baker_bal_rewards expected_rewards >>=? fun () -> - - (* test that revealing twice produces an error *) - Op.seed_nonce_revelation (B b) level_commitment (Nonce.get wrong_hash) >>=? fun operation -> - Block.bake ~operation ~policy b >>= fun e -> - Assert.proto_error ~loc:__LOC__ e begin function - | Nonce_storage.Previously_revealed_nonce -> true - | _ -> false - end >>=? fun () -> - - (* bake [preserved_cycles] cycles excluding [id] *) - Error_monad.fold_left_s (fun b _ -> Block.bake_until_cycle_end ~policy b) - b (1 -- preserved_cycles) >>=? fun b -> - - (* test that [id] receives back the bond and the reward *) - (* note that in order to have that new_bal = bal_main + reward, - id can only bake once; this is why we exclude id from all other bake ops. *) - balance_was_credited ~loc:__LOC__ - (B b) id ~kind:Main bal_main reward >>=? fun () -> - balance_is ~loc:__LOC__ - (B b) id ~kind:Deposit Tez.zero >>=? fun () -> - balance_is ~loc:__LOC__ - (B b) id ~kind:Rewards Tez.zero - - -(** Tests that: - - a committer at cycle 0, which doesn't reveal at cycle 1, - at the end of the cycle 1 looses the bond and the reward - - revealing too late produces an error -*) -let revelation_missing_and_late () = - let open Context in - let open Assert in - - Context.init 5 >>=? fun (b,_) -> - get_constants (B b) >>=? fun csts -> - baking_reward (B b) b >>=? fun reward -> - let blocks_per_commitment = Int32.to_int csts.parametric.blocks_per_commitment in - - (* bake until commitment *) - Block.bake_n (blocks_per_commitment-2) b >>=? fun b -> - (* the next baker [id] will include a seed_nonce commitment *) - Block.get_next_baker b >>=? fun (pkh,_,_) -> - let id = Alpha_context.Contract.implicit_contract pkh in - Block.bake b >>=? fun b -> - Context.get_level (B b) >>=? fun level_commitment -> - Context.get_seed_nonce_hash (B b) >>=? fun committed_hash -> - Context.Contract.balance ~kind:Main (B b) id >>=? fun bal_main -> - Context.Contract.balance ~kind:Deposit (B b) id >>=? fun bal_deposit -> - Context.Contract.balance ~kind:Rewards (B b) id >>=? fun bal_rewards -> - - (* finish cycle 0 excluding the committing baker [id] *) - let policy = Block.Excluding [pkh] in - Block.bake_until_cycle_end ~policy b >>=? fun b -> - (* finish cycle 1 excluding the committing baker [id] *) - Block.bake_until_cycle_end ~policy b >>=? fun b -> - - (* test that baker [id], which didn't reveal at cycle 1 like it was supposed to, - at the end of the cycle 1 looses the reward but not the bond *) - balance_is ~loc:__LOC__ (B b) id ~kind:Main bal_main >>=? fun () -> - balance_is ~loc:__LOC__ (B b) id ~kind:Deposit bal_deposit >>=? fun () -> - balance_was_debited ~loc:__LOC__ - (B b) id ~kind:Rewards bal_rewards reward >>=? fun () -> - - (* test that revealing too late (after cycle 1) produces an error *) - Op.seed_nonce_revelation (B b) level_commitment (Nonce.get committed_hash) >>=? fun operation -> - Block.bake ~operation b >>= fun e -> - Assert.proto_error ~loc:__LOC__ e begin function - | Nonce_storage.Too_late_revelation -> true - | _ -> false - end - - -let tests = [ - Test.tztest "no commitment" `Quick no_commitment ; - Test.tztest "revelation_early_wrong_right_twice" `Quick revelation_early_wrong_right_twice ; - Test.tztest "revelation_missing_and_late" `Quick revelation_missing_and_late ; -] diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/test.ml b/vendors/ligo-utils/tezos-protocol-alpha/test/test.ml deleted file mode 100644 index e8c2f3828..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/test.ml +++ /dev/null @@ -1,35 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -(* 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.Internal_event_unix.close () >>= fun () -> - Format.printf "@.%a@." pp_print_error err ; - Lwt.fail Alcotest.Test_error - end diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/transfer.ml b/vendors/ligo-utils/tezos-protocol-alpha/test/transfer.ml deleted file mode 100644 index 275736201..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/transfer.ml +++ /dev/null @@ -1,597 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol -open Alpha_context -open Test_utils -open Test_tez - -(*********************************************************************) -(* Utility functions *) -(*********************************************************************) - -(** - [transfer_and_check_balances b fee src dst amount] - this function takes a block, an optional parameter fee if fee does not - given it will be set to zero tez, a source contract, a destination contract - and the amount that one wants to transfer. - - 1- Transfer the amount of tez (w/wo fee) from a source contract to a - destination contract. - - 2- Check the equivalent of the balance of the source/destination - contract before and after transfer is valided. - - This function returns a pair: - - A block that added a valid operation - - a valid operation -*) -let transfer_and_check_balances ?(with_burn = false) ~loc b ?(fee=Tez.zero) ?expect_failure src dst amount = - Tez.(+?) fee amount >>?= fun amount_fee -> - Context.Contract.balance (I b) src >>=? fun bal_src -> - Context.Contract.balance (I b) dst >>=? fun bal_dst -> - Op.transaction (I b) ~fee src dst amount >>=? fun op -> - Incremental.add_operation ?expect_failure b op >>=? fun b -> - Context.get_constants (I b) >>=? fun { parametric = { origination_size ; cost_per_byte ; _ } ; _ } -> - Tez.(cost_per_byte *? Int64.of_int origination_size) >>?= fun origination_burn -> - let amount_fee_maybe_burn = - if with_burn then - match Tez.(amount_fee +? origination_burn) with - | Ok r -> r - | Error _ -> assert false - else - amount_fee in - Assert.balance_was_debited ~loc (I b) src bal_src amount_fee_maybe_burn >>=? fun () -> - Assert.balance_was_credited ~loc (I b) dst bal_dst amount >>=? fun () -> - return (b, op) - -(** - [transfer_to_itself_and_check_balances b fee contract amount] - this function takes a block, an optional parameter fee, - a contract that is a source and a destination contract, - and an amount of tez that one wants to transfer. - - 1- Transfer the amount of tez (w/wo transfer fee) from/to a contract itself. - - 2- Check the equivalent of the balance of the contract before - and after transfer. - - This function returns a pair: - - a block that added the valid transaction - - an valid transaction -*) -let transfer_to_itself_and_check_balances ~loc b ?(fee=Tez.zero) contract amount = - Context.Contract.balance (I b) contract >>=? fun bal -> - Op.transaction (I b) ~fee contract contract amount >>=? fun op -> - Incremental.add_operation b op >>=? fun b -> - Assert.balance_was_debited ~loc (I b) contract bal fee >>=? fun () -> - return (b, op) - -(** - [n_transactions n b fee source dest amount] - this function takes a number of "n" that one wish to transfer, - a block, an optional parameter fee, a source contract, - a destination contract and an amount one wants to transfer. - - This function will do a transaction from a source contract to - a destination contract with the amount "n" times. -*) -let n_transactions n b ?fee source dest amount = - fold_left_s (fun b _ -> - transfer_and_check_balances ~loc:__LOC__ b ?fee source dest amount >>=? fun (b,_) -> - return b) - b (1 -- n) - -let ten_tez = Tez.of_int 10 - -(*********************************************************************) -(* Tests *) -(*********************************************************************) - -let register_two_contracts () = - Context.init 2 >>=? fun (b, contracts) -> - let contract_1 = List.nth contracts 0 in - let contract_2 = List.nth contracts 1 in - return (b, contract_1, contract_2) - - -(** compute half of the balance and divided by nth - times *) - -let two_nth_of_balance incr contract nth = - Context.Contract.balance (I incr) contract >>=? fun balance -> - Tez.(/?) balance nth >>?= fun res -> - Tez.( *?) res 2L >>?= fun balance -> - return balance - -(********************) -(** Single transfer *) -(********************) - -let single_transfer ?fee ?expect_failure amount = - register_two_contracts () >>=? fun (b, contract_1, contract_2) -> - Incremental.begin_construction b >>=? fun b -> - transfer_and_check_balances ~loc:__LOC__ ?fee ?expect_failure - b contract_1 contract_2 amount >>=? fun (b,_) -> - Incremental.finalize_block b >>=? fun _ -> - return_unit - -(** single transfer without fee *) -let block_with_a_single_transfer () = - single_transfer Tez.one - -(** single transfer with fee *) -let block_with_a_single_transfer_with_fee () = - single_transfer ~fee:Tez.one Tez.one - -(** single transfer without fee *) - -let transfer_zero_tez () = - single_transfer ~expect_failure:( - function - | Environment.Ecoproto_error (Contract_storage.Empty_transaction _) :: _ -> - return_unit - | _ -> - failwith "Empty transaction should fail") - Tez.zero - -(********************) -(** Transfer zero tez from an implicit contract *) -(********************) - -let transfer_zero_implicit () = - Context.init 1 >>=? fun (b, contracts) -> - let dest = List.nth contracts 0 in - let account = Account.new_account () in - Incremental.begin_construction b >>=? fun i -> - let src = Contract.implicit_contract account.Account.pkh in - Op.transaction (I i) src dest Tez.zero >>=? fun op -> - Incremental.add_operation i op >>= fun res -> - Assert.proto_error ~loc:__LOC__ res begin function - | Contract_storage.Empty_implicit_contract _ -> true - | _ -> false - end - -(********************) -(** Transfer to originted contract *) -(********************) - -let transfer_to_originate_with_fee () = - Context.init 1 >>=? fun (b, contracts) -> - let contract = List.nth contracts 0 in - Incremental.begin_construction b >>=? fun b -> - two_nth_of_balance b contract 10L >>=? fun fee -> - (* originated contract, paying a fee to originated this contract *) - Op.origination (I b) ~fee:ten_tez contract ~script:Op.dummy_script >>=? fun (operation, new_contract) -> - Incremental.add_operation b operation >>=? fun b -> - two_nth_of_balance b contract 3L >>=? fun amount -> - transfer_and_check_balances ~loc:__LOC__ b ~fee:fee contract - new_contract amount >>=? fun (b, _) -> - Incremental.finalize_block b >>=? fun _ -> - return_unit - -(********************) -(** Transfer from balance *) -(********************) - -let transfer_amount_of_contract_balance () = - register_two_contracts () >>=? fun (b, contract_1, contract_2) -> - Context.Contract.pkh contract_1 >>=? fun pkh1 -> - (* given that contract_1 no longer has a sufficient balance to bake, - make sure it cannot be chosen as baker *) - Incremental.begin_construction b ~policy:(Block.Excluding [pkh1]) >>=? fun b -> - (* get the balance of the source contract *) - Context.Contract.balance (I b) contract_1 >>=? fun balance -> - (* transfer all the tez inside contract 1 *) - transfer_and_check_balances ~loc:__LOC__ - b contract_1 contract_2 balance >>=? fun (b,_) -> - Incremental.finalize_block b >>=? fun _ -> - return_unit - -(********************) -(** Transfer to itself *) -(********************) - -let transfers_to_self () = - Context.init 1 >>=? fun (b, contracts) -> - let contract = List.nth contracts 0 in - Incremental.begin_construction b >>=? fun b -> - two_nth_of_balance b contract 3L >>=? fun amount -> - transfer_to_itself_and_check_balances ~loc:__LOC__ b contract amount - >>=? fun (b, _) -> - two_nth_of_balance b contract 5L >>=? fun fee -> - transfer_to_itself_and_check_balances ~loc:__LOC__ b ~fee:fee contract ten_tez - >>=? fun (b, _) -> - Incremental.finalize_block b >>=? fun _ -> - return_unit - -(********************) -(** Forgot to add the valid transaction into the block *) -(********************) - -let missing_transaction () = - register_two_contracts () >>=? fun (b, contract_1, contract_2) -> - (* given that contract_1 no longer has a sufficient balance to bake, - make sure it cannot be chosen as baker *) - Context.Contract.pkh contract_1 >>=? fun pkh1 -> - Incremental.begin_construction b ~policy:(Block.Excluding [pkh1]) >>=? fun b -> - two_nth_of_balance b contract_1 6L >>=? fun amount -> - (* do the transfer 3 times from source contract to destination contract *) - n_transactions 3 b contract_1 contract_2 amount >>=? fun b -> - (* do the fourth transfer from source contract to destination contract *) - Op.transaction (I b) contract_1 contract_2 amount >>=? fun _ -> - Incremental.finalize_block b >>=? fun _ -> - return_unit - -(********************) -(** These following tests are for different kind of contracts: - - implicit to implicit - - implicit to originated - - originated to implicit - - originted to originted *) -(********************) - -(** Implicit to Implicit *) - -let transfer_from_implicit_to_implicit_contract () = - Context.init 1 >>=? fun (b, contracts) -> - let bootstrap_contract = List.nth contracts 0 in - let account_a = Account.new_account () in - let account_b = Account.new_account () in - Incremental.begin_construction b >>=? fun b -> - let src = Contract.implicit_contract account_a.Account.pkh in - two_nth_of_balance b bootstrap_contract 3L >>=? fun amount1 -> - two_nth_of_balance b bootstrap_contract 10L >>=? fun fee1 -> - transfer_and_check_balances ~with_burn:true ~loc:__LOC__ ~fee:fee1 b - bootstrap_contract src amount1 >>=? fun (b, _) -> - (* create an implicit contract as a destination contract *) - let dest = Contract.implicit_contract account_b.pkh in - two_nth_of_balance b bootstrap_contract 4L >>=? fun amount2 -> - two_nth_of_balance b bootstrap_contract 10L >>=? fun fee2 -> - (* transfer from implicit contract to another implicit contract *) - transfer_and_check_balances ~with_burn:true ~loc:__LOC__ ~fee:fee2 b - src dest amount2 >>=? fun (b, _) -> - Incremental.finalize_block b >>=? fun _ -> - return_unit - -(** Implicit to originated *) - -let transfer_from_implicit_to_originated_contract () = - Context.init 1 >>=? fun (b, contracts) -> - let bootstrap_contract = List.nth contracts 0 in - let contract = List.nth contracts 0 in - let account = Account.new_account () in - let src = Contract.implicit_contract account.Account.pkh in - Incremental.begin_construction b >>=? fun b -> - two_nth_of_balance b bootstrap_contract 3L >>=? fun amount1 -> - (* transfer the money to implicit contract *) - transfer_and_check_balances ~with_burn:true ~loc:__LOC__ b bootstrap_contract src amount1 - >>=? fun (b, _) -> - (* originated contract *) - Op.origination (I b) contract ~script:Op.dummy_script >>=? fun (operation, new_contract) -> - Incremental.add_operation b operation >>=? fun b -> - two_nth_of_balance b bootstrap_contract 4L >>=? fun amount2 -> - (* transfer from implicit contract to originated contract *) - transfer_and_check_balances ~loc:__LOC__ b src new_contract amount2 - >>=? fun (b, _) -> - Incremental.finalize_block b >>=? fun _ -> - return_unit - -(********************) -(** Slow tests case *) -(********************) - -let multiple_transfer n ?fee amount = - register_two_contracts () >>=? fun (b, contract_1, contract_2) -> - Incremental.begin_construction b >>=? fun b -> - n_transactions n b ?fee contract_1 contract_2 amount >>=? fun b -> - Incremental.finalize_block b >>=? fun _ -> - return_unit - -(** 1- Create a block with two contracts; - 2- Apply 100 transfers. *) -let block_with_multiple_transfers () = - multiple_transfer 99 (Tez.of_int 1000) - -(** 1- Create a block with two contracts; - 2- Apply 100 transfers with 10tz fee. *) -let block_with_multiple_transfers_pay_fee () = - multiple_transfer 10 ~fee:ten_tez (Tez.of_int 1000) - -(** 1- Create a block with 8 contracts; - 2- Apply multiple transfers without fees; - 3- Apply multiple transfers with fees. *) -(* TODO : increase the number of operations and add a `Slow tag to it in `tests` *) -let block_with_multiple_transfers_with_without_fee () = - Context.init 8 >>=? fun (b, contracts) -> - let contracts = Array.of_list contracts in - Incremental.begin_construction b >>=? fun b -> - let hundred = Tez.of_int 100 in - let ten = Tez.of_int 10 in - let twenty = Tez.of_int 20 in - n_transactions 10 b contracts.(0) contracts.(1) Tez.one >>=? fun b -> - n_transactions 30 b contracts.(1) contracts.(2) hundred >>=? fun b -> - n_transactions 30 b contracts.(1) contracts.(3) hundred >>=? fun b -> - n_transactions 30 b contracts.(4) contracts.(3) hundred >>=? fun b -> - n_transactions 20 b contracts.(0) contracts.(1) hundred >>=? fun b -> - n_transactions 10 b contracts.(1) contracts.(3) hundred >>=? fun b -> - n_transactions 10 b contracts.(1) contracts.(3) hundred >>=? fun b -> - - n_transactions 20 ~fee:ten b contracts.(3) contracts.(4) ten >>=? fun b -> - n_transactions 10 ~fee:twenty b contracts.(4) contracts.(5) ten >>=? fun b -> - n_transactions 70 ~fee:twenty b contracts.(6) contracts.(0) twenty >>=? fun b -> - n_transactions 550 ~fee:twenty b contracts.(6) contracts.(4) twenty >>=? fun b -> - n_transactions 50 ~fee:ten b contracts.(7) contracts.(5) twenty >>=? fun b -> - n_transactions 30 ~fee:ten b contracts.(0) contracts.(7) hundred >>=? fun b -> - n_transactions 20 ~fee:ten b contracts.(1) contracts.(0) twenty >>=? fun b -> - - Incremental.finalize_block b >>=? fun _ -> - return_unit - -(********************) -(** Build a chain that has 10 blocks. *) -(********************) - -let build_a_chain () = - register_two_contracts () >>=? fun (b, contract_1, contract_2) -> - let ten = Tez.of_int 10 in - fold_left_s (fun b _ -> - Incremental.begin_construction b >>=? fun b -> - transfer_and_check_balances ~loc:__LOC__ b contract_1 contract_2 ten - >>=? fun (b, _) -> - Incremental.finalize_block b - ) b (1 -- 10) >>=? fun _ -> - return_unit - -(*********************************************************************) -(* Expected error test cases *) -(*********************************************************************) - -(********************) -(** transfer zero tez is forbidden in implicit contract *) -(********************) - -let empty_implicit () = - Context.init 1 >>=? fun (b, contracts) -> - let dest = List.nth contracts 0 in - let account = Account.new_account () in - Incremental.begin_construction b >>=? fun incr -> - let src = Contract.implicit_contract account.Account.pkh in - two_nth_of_balance incr dest 3L >>=? fun amount -> - (* transfer zero tez from an implicit contract *) - Op.transaction (I incr) src dest amount >>=? fun op -> - Incremental.add_operation incr op >>= fun res -> - Assert.proto_error ~loc:__LOC__ res begin function - | Contract_storage.Empty_implicit_contract _ -> true - | _ -> false - end - -(********************) -(** Balance is too low to transfer *) -(********************) - -let balance_too_low fee () = - register_two_contracts () >>=? fun (b, contract_1, contract_2) -> - Incremental.begin_construction b >>=? fun i -> - Context.Contract.balance (I i) contract_1 >>=? fun balance1 -> - Context.Contract.balance (I i) contract_2 >>=? fun balance2 -> - (* transfer the amount of tez that is bigger than the balance in the source contract *) - Op.transaction ~fee (I i) contract_1 contract_2 Tez.max_tez >>=? fun op -> - let expect_failure = function - | Environment.Ecoproto_error (Contract_storage.Balance_too_low _) :: _ -> - return_unit - | _ -> - failwith "balance too low should fail" - in - (* the fee is higher than the balance then raise an error "Balance_too_low" *) - if fee > balance1 then begin - Incremental.add_operation ~expect_failure i op >>= fun _res -> - return_unit - end - (* the fee is smaller than the balance, then the transfer is accepted - but it is not processed, and fees are taken *) - else begin - Incremental.add_operation ~expect_failure i op >>=? fun i -> - (* contract_1 loses the fees *) - Assert.balance_was_debited ~loc:__LOC__ (I i) contract_1 balance1 fee >>=? fun () -> - (* contract_2 is not credited *) - Assert.balance_was_credited ~loc:__LOC__ (I i) contract_2 balance2 Tez.zero - end - -(** 1- Create a block, and three contracts; - 2- Add a transfer that at the end the balance of a contract is - zero into this block; - 3- Add another transfer that send tez from a zero balance contract; - 4- Catch the expected error: Balance_too_low. *) -let balance_too_low_two_transfers fee () = - Context.init 3 >>=? fun (b, contracts) -> - let contract_1 = List.nth contracts 0 in - let contract_2 = List.nth contracts 1 in - let contract_3 = List.nth contracts 2 in - Incremental.begin_construction b >>=? fun i -> - Context.Contract.balance (I i) contract_1 >>=? fun balance -> - Tez.(/?) balance 3L >>?= fun res -> - Tez.( *?) res 2L >>?= fun two_third_of_balance -> - transfer_and_check_balances ~loc:__LOC__ i - contract_1 contract_2 two_third_of_balance >>=? fun (i, _) -> - Context.Contract.balance (I i) contract_1 >>=? fun balance1 -> - Context.Contract.balance (I i) contract_3 >>=? fun balance3 -> - Op.transaction ~fee (I i) contract_1 contract_3 - two_third_of_balance >>=? fun operation -> - let expect_failure = function - | Environment.Ecoproto_error (Contract_storage.Balance_too_low _) :: _ -> - return_unit - | _ -> - failwith "balance too low should fail" - in - Incremental.add_operation ~expect_failure i operation >>=? fun i -> - (* contract_1 loses the fees *) - Assert.balance_was_debited ~loc:__LOC__ (I i) contract_1 balance1 fee >>=? fun () -> - (* contract_3 is not credited *) - Assert.balance_was_credited ~loc:__LOC__ (I i) contract_3 balance3 Tez.zero - -(********************) -(** The counter is already used for the previous operation *) -(********************) - -let invalid_counter () = - register_two_contracts () >>=? fun (b, contract_1, contract_2) -> - Incremental.begin_construction b >>=? fun b -> - Op.transaction (I b) contract_1 contract_2 - Tez.one >>=? fun op1 -> - Op.transaction (I b) contract_1 contract_2 - Tez.one >>=? fun op2 -> - Incremental.add_operation b op1 >>=? fun b -> - Incremental.add_operation b op2 >>= fun b -> - Assert.proto_error ~loc:__LOC__ b begin function - | Contract_storage.Counter_in_the_past _ -> true - | _ -> false - end - -(* same as before but different way to perform this error *) - -let add_the_same_operation_twice () = - register_two_contracts () >>=? fun (b, contract_1, contract_2) -> - Incremental.begin_construction b >>=? fun b -> - transfer_and_check_balances ~loc:__LOC__ b contract_1 contract_2 ten_tez - >>=? fun (b, op_transfer) -> - Op.transaction (I b) contract_1 contract_2 ten_tez >>=? fun _ -> - Incremental.add_operation b op_transfer >>= fun b -> - Assert.proto_error ~loc:__LOC__ b begin function - | Contract_storage.Counter_in_the_past _ -> true - | _ -> false - end - -(********************) -(** check ownership *) -(********************) - -let ownership_sender () = - register_two_contracts () >>=? fun (b, contract_1, contract_2) -> - Incremental.begin_construction b >>=? fun b -> - (* get the manager of the contract_1 as a sender *) - Context.Contract.manager (I b) contract_1 >>=? fun manager -> - (* create an implicit_contract *) - let imcontract_1 = Alpha_context.Contract.implicit_contract manager.pkh in - transfer_and_check_balances ~loc:__LOC__ b imcontract_1 contract_2 Tez.one - >>=? fun (b,_) -> - Incremental.finalize_block b >>=? fun _ -> - return_unit - -(*********************************************************************) -(** Random transfer *) - -(** Return a pair of minimum and maximum random number *) -let random_range (min, max) = - let interv = max - min + 1 in - let init = - Random.self_init (); - (Random.int interv) + min - in init - -(** Return a random contract *) -let random_contract contract_array = - let i = Random.int (Array.length contract_array) in - contract_array.(i) - -(** Transfer by randomly choose amount 10 contracts, and randomly - choose the amount in the source contract *) -let random_transfer () = - Context.init 10 >>=? fun (b, contracts) -> - let contracts = Array.of_list contracts in - let source = random_contract contracts in - let dest = random_contract contracts in - Context.Contract.pkh source >>=? fun source_pkh -> - (* given that source may not have a sufficient balance for the transfer + to bake, - make sure it cannot be chosen as baker *) - Incremental.begin_construction b ~policy:(Block.Excluding [source_pkh]) >>=? fun b -> - Context.Contract.balance (I b) source >>=? fun amount -> - begin - if source = dest - then - transfer_to_itself_and_check_balances ~loc:__LOC__ b source amount - else - transfer_and_check_balances ~loc:__LOC__ b source dest amount - end >>=? fun (b,_) -> - Incremental.finalize_block b >>=? fun _ -> - return_unit - -(** Transfer random transactions *) -let random_multi_transactions () = - let n = random_range (1, 100) in - multiple_transfer n (Tez.of_int 100) - -(*********************************************************************) - -let tests = [ - (* single transfer *) - Test.tztest "single transfer" `Quick block_with_a_single_transfer ; - Test.tztest "single transfer with fee" `Quick block_with_a_single_transfer_with_fee ; - - (* transfer zero tez *) - Test.tztest "single transfer zero tez" `Quick transfer_zero_tez ; - Test.tztest "transfer zero tez from implicit contract" `Quick transfer_zero_implicit; - - (* transfer to originated contract *) - Test.tztest "transfer to originated contract paying transaction fee" `Quick transfer_to_originate_with_fee ; - - (* transfer by the balance of contract *) - Test.tztest "transfer the amount from source contract balance" `Quick transfer_amount_of_contract_balance ; - - (* transfer to itself *) - Test.tztest "transfers to itself" `Quick transfers_to_self ; - - (* missing operation *) - - Test.tztest "missing transaction" `Quick missing_transaction ; - - (* transfer from/to implicit/originted contracts*) - Test.tztest "transfer from an implicit to implicit contract " `Quick transfer_from_implicit_to_implicit_contract ; - Test.tztest "transfer from an implicit to an originated contract" `Quick transfer_from_implicit_to_originated_contract ; - - (* Slow tests *) - Test.tztest "block with multiple transfers" `Slow block_with_multiple_transfers ; - (* TODO increase the number of transaction times *) - Test.tztest "block with multiple transfer paying fee" `Slow block_with_multiple_transfers_pay_fee ; - Test.tztest "block with multiple transfer without paying fee" `Slow block_with_multiple_transfers_with_without_fee ; - - (* build the chain *) - Test.tztest "build a chain" `Quick build_a_chain ; - - (* Erroneous *) - Test.tztest "empty implicit" `Quick empty_implicit; - Test.tztest "balance too low - transfer zero" `Quick (balance_too_low Tez.zero); - Test.tztest "balance too low" `Quick (balance_too_low Tez.one); - Test.tztest "balance too low (max fee)" `Quick (balance_too_low Tez.max_tez); - Test.tztest "balance too low with two transfers - transfer zero" `Quick (balance_too_low_two_transfers Tez.zero); - Test.tztest "balance too low with two transfers" `Quick (balance_too_low_two_transfers Tez.one); - Test.tztest "invalid_counter" `Quick invalid_counter ; - Test.tztest "add the same operation twice" `Quick add_the_same_operation_twice ; - - Test.tztest "ownership sender" `Quick ownership_sender ; - (* Random tests *) - Test.tztest "random transfer" `Quick random_transfer ; - Test.tztest "random multi transfer" `Quick random_multi_transactions ; -] diff --git a/vendors/ligo-utils/tezos-protocol-alpha/test/voting.ml b/vendors/ligo-utils/tezos-protocol-alpha/test/voting.ml deleted file mode 100644 index d188405ce..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/test/voting.ml +++ /dev/null @@ -1,943 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol -open Test_utils - -(* missing stuff in Alpha_context.Vote *) -let ballots_zero = Alpha_context.Vote.{ yay = 0l ; nay = 0l ; pass = 0l } -let ballots_equal b1 b2 = - Alpha_context.Vote.(b1.yay = b2.yay && b1.nay = b2.nay && b1.pass = b2.pass) -let ballots_pp ppf v = Alpha_context.Vote.( - Format.fprintf ppf "{ yay = %ld ; nay = %ld ; pass = %ld" v.yay v.nay v.pass) - -(* constants and ratios used in voting: - percent_mul denotes the percent multiplier - initial_participation is 7000 that is, 7/10 * percent_mul - the participation EMA ratio pr_ema_weight / den = 7 / 10 - the participation ratio pr_num / den = 2 / 10 - note: we use the same denominator for both participation EMA and participation rate. - supermajority rate is s_num / s_den = 8 / 10 *) -let percent_mul = 100_00 -let initial_participation_num = 7 -let initial_participation = initial_participation_num * percent_mul / 10 -let pr_ema_weight = 8 -let den = 10 -let pr_num = den - pr_ema_weight -let s_num = 8 -let s_den = 10 -let qr_min_num = 2 -let qr_max_num = 7 -let expected_qr_num = - Float.(of_int qr_min_num +. - of_int initial_participation_num *. (of_int qr_max_num -. of_int qr_min_num) /. of_int den) - -(* Protocol_hash.zero is "PrihK96nBAFSxVL1GLJTVhu9YnzkMFiBeuJRPA8NwuZVZCE1L6i" *) -let protos = Array.map (fun s -> Protocol_hash.of_b58check_exn s) - [| "ProtoALphaALphaALphaALphaALphaALphaALpha61322gcLUGH" ; - "ProtoALphaALphaALphaALphaALphaALphaALphabc2a7ebx6WB" ; - "ProtoALphaALphaALphaALphaALphaALphaALpha84efbeiF6cm" ; - "ProtoALphaALphaALphaALphaALphaALphaALpha91249Z65tWS" ; - "ProtoALphaALphaALphaALphaALphaALphaALpha537f5h25LnN" ; - "ProtoALphaALphaALphaALphaALphaALphaALpha5c8fefgDYkr" ; - "ProtoALphaALphaALphaALphaALphaALphaALpha3f31feSSarC" ; - "ProtoALphaALphaALphaALphaALphaALphaALphabe31ahnkxSC" ; - "ProtoALphaALphaALphaALphaALphaALphaALphabab3bgRb7zQ" ; - "ProtoALphaALphaALphaALphaALphaALphaALphaf8d39cctbpk" ; - "ProtoALphaALphaALphaALphaALphaALphaALpha3b981byuYxD" ; - "ProtoALphaALphaALphaALphaALphaALphaALphaa116bccYowi" ; - "ProtoALphaALphaALphaALphaALphaALphaALphacce68eHqboj" ; - "ProtoALphaALphaALphaALphaALphaALphaALpha225c7YrWwR7" ; - "ProtoALphaALphaALphaALphaALphaALphaALpha58743cJL6FG" ; - "ProtoALphaALphaALphaALphaALphaALphaALphac91bcdvmJFR" ; - "ProtoALphaALphaALphaALphaALphaALphaALpha1faaadhV7oW" ; - "ProtoALphaALphaALphaALphaALphaALphaALpha98232gD94QJ" ; - "ProtoALphaALphaALphaALphaALphaALphaALpha9d1d8cijvAh" ; - "ProtoALphaALphaALphaALphaALphaALphaALphaeec52dKF6Gx" ; - "ProtoALphaALphaALphaALphaALphaALphaALpha841f2cQqajX" ; |] - -(** helper functions *) -let mk_contracts_from_pkh pkh_list = - List.map (Alpha_context.Contract.implicit_contract) pkh_list - -(* get the list of delegates and the list of their rolls from listings *) -let get_delegates_and_rolls_from_listings b = - Context.Vote.get_listings (B b) >>=? fun l -> - return ((mk_contracts_from_pkh (List.map fst l)), List.map snd l) - -(* compute the rolls of each delegate *) -let get_rolls b delegates loc = - Context.Vote.get_listings (B b) >>=? fun l -> - map_s (fun delegate -> - Context.Contract.pkh delegate >>=? fun pkh -> - match List.find_opt (fun (del,_) -> del = pkh) l with - | None -> failwith "%s - Missing delegate" loc - | Some (_, rolls) -> return rolls - ) delegates - -let test_successful_vote num_delegates () = - let min_proposal_quorum = Int32.(of_int @@ 100_00 / num_delegates) in - Context.init ~min_proposal_quorum num_delegates >>=? fun (b,_) -> - Context.get_constants (B b) >>=? - fun { parametric = {blocks_per_voting_period ; _ } ; _ } -> - - (* no ballots in proposal period *) - Context.Vote.get_ballots (B b) >>=? fun v -> - Assert.equal ~loc:__LOC__ ballots_equal "Unexpected ballots" ballots_pp - v ballots_zero >>=? fun () -> - - (* no ballots in proposal period *) - Context.Vote.get_ballot_list (B b) >>=? begin function - | [] -> return_unit - | _ -> failwith "%s - Unexpected ballot list" __LOC__ - end >>=? fun () -> - - (* period 0 *) - Context.Vote.get_voting_period (B b) >>=? fun v -> - let open Alpha_context in - Assert.equal ~loc:__LOC__ Voting_period.equal "Unexpected period" - Voting_period.pp v Voting_period.(root) - >>=? fun () -> - - Context.Vote.get_current_period_kind (B b) >>=? begin function - | Proposal -> return_unit - | _ -> failwith "%s - Unexpected period kind" __LOC__ - end >>=? fun () -> - - (* participation EMA starts at initial_participation *) - Context.Vote.get_participation_ema b >>=? fun v -> - Assert.equal_int ~loc:__LOC__ initial_participation (Int32.to_int v) >>=? fun () -> - - (* listings must be populated in proposal period *) - Context.Vote.get_listings (B b) >>=? begin function - | [] -> failwith "%s - Unexpected empty listings" __LOC__ - | _ -> return_unit - end >>=? fun () -> - - (* beginning of proposal, denoted by _p1; - take a snapshot of the active delegates and their rolls from listings *) - get_delegates_and_rolls_from_listings b >>=? fun (delegates_p1, rolls_p1) -> - - (* no proposals at the beginning of proposal period *) - Context.Vote.get_proposals (B b) >>=? fun ps -> - begin if Environment.Protocol_hash.Map.is_empty ps - then return_unit - else failwith "%s - Unexpected proposals" __LOC__ - end >>=? fun () -> - - (* no current proposal during proposal period *) - Context.Vote.get_current_proposal (B b) >>=? begin function - | None -> return_unit - | Some _ -> failwith "%s - Unexpected proposal" __LOC__ - end >>=? fun () -> - - let del1 = List.nth delegates_p1 0 in - let del2 = List.nth delegates_p1 1 in - let props = List.map (fun i -> protos.(i)) - (2 -- Constants.max_proposals_per_delegate) in - Op.proposals (B b) del1 (Protocol_hash.zero::props) >>=? fun ops1 -> - Op.proposals (B b) del2 [Protocol_hash.zero] >>=? fun ops2 -> - Block.bake ~operations:[ops1;ops2] b >>=? fun b -> - - (* proposals are now populated *) - Context.Vote.get_proposals (B b) >>=? fun ps -> - - (* correctly count the double proposal for zero *) - begin - let weight = Int32.add (List.nth rolls_p1 0) (List.nth rolls_p1 1) in - match Environment.Protocol_hash.(Map.find_opt zero ps) with - | Some v -> if v = weight then return_unit - else failwith "%s - Wrong count %ld is not %ld" __LOC__ v weight - | None -> failwith "%s - Missing proposal" __LOC__ - end >>=? fun () -> - - (* proposing more than maximum_proposals fails *) - Op.proposals (B b) del1 (Protocol_hash.zero::props) >>=? fun ops -> - Block.bake ~operations:[ops] b >>= fun res -> - Assert.proto_error ~loc:__LOC__ res begin function - | Amendment.Too_many_proposals -> true - | _ -> false - end >>=? fun () -> - - (* proposing less than one proposal fails *) - Op.proposals (B b) del1 [] >>=? fun ops -> - Block.bake ~operations:[ops] b >>= fun res -> - Assert.proto_error ~loc:__LOC__ res begin function - | Amendment.Empty_proposal -> true - | _ -> false - end >>=? fun () -> - - (* skip to testing_vote period - -1 because we already baked one block with the proposal *) - Block.bake_n ((Int32.to_int blocks_per_voting_period)-2) b >>=? fun b -> - - (* we moved to a testing_vote period with one proposal *) - Context.Vote.get_current_period_kind (B b) >>=? begin function - | Testing_vote -> return_unit - | _ -> failwith "%s - Unexpected period kind" __LOC__ - end >>=? fun () -> - - (* period 1 *) - Context.Vote.get_voting_period (B b) >>=? fun v -> - let open Alpha_context in - Assert.equal ~loc:__LOC__ Voting_period.equal "Unexpected period" - Voting_period.pp v Voting_period.(succ root) - >>=? fun () -> - - (* listings must be populated in testing_vote period *) - Context.Vote.get_listings (B b) >>=? begin function - | [] -> failwith "%s - Unexpected empty listings" __LOC__ - | _ -> return_unit - end >>=? fun () -> - - (* beginning of testing_vote period, denoted by _p2; - take a snapshot of the active delegates and their rolls from listings *) - get_delegates_and_rolls_from_listings b >>=? fun (delegates_p2, rolls_p2) -> - - (* no proposals during testing_vote period *) - Context.Vote.get_proposals (B b) >>=? fun ps -> - begin if Environment.Protocol_hash.Map.is_empty ps - then return_unit - else failwith "%s - Unexpected proposals" __LOC__ - end >>=? fun () -> - - (* current proposal must be set during testing_vote period *) - Context.Vote.get_current_proposal (B b) >>=? begin function - | Some v -> if Protocol_hash.(equal zero v) then return_unit - else failwith "%s - Wrong proposal" __LOC__ - | None -> failwith "%s - Missing proposal" __LOC__ - end >>=? fun () -> - - (* unanimous vote: all delegates --active when p2 started-- vote *) - map_s (fun del -> - Op.ballot (B b) del Protocol_hash.zero Vote.Yay) - delegates_p2 >>=? fun operations -> - Block.bake ~operations b >>=? fun b -> - - Op.ballot (B b) del1 Protocol_hash.zero Vote.Nay >>=? fun op -> - Block.bake ~operations:[op] b >>= fun res -> - Assert.proto_error ~loc:__LOC__ res begin function - | Amendment.Unauthorized_ballot -> true - | _ -> false - end >>=? fun () -> - - fold_left_s (fun v acc -> return Int32.(add v acc)) - 0l rolls_p2 >>=? fun rolls_sum -> - - (* # of Yays in ballots matches rolls of the delegate *) - Context.Vote.get_ballots (B b) >>=? fun v -> - Assert.equal ~loc:__LOC__ ballots_equal "Unexpected ballots" ballots_pp - v Vote.{ yay = rolls_sum ; nay = 0l ; pass = 0l } >>=? fun () -> - - (* One Yay ballot per delegate *) - Context.Vote.get_ballot_list (B b) >>=? begin function - | [] -> failwith "%s - Unexpected empty ballot list" __LOC__ - | l -> - iter_s (fun delegate -> - Context.Contract.pkh delegate >>=? fun pkh -> - match List.find_opt (fun (del,_) -> del = pkh) l with - | None -> failwith "%s - Missing delegate" __LOC__ - | Some (_, Vote.Yay) -> return_unit - | Some _ -> failwith "%s - Wrong ballot" __LOC__ - ) delegates_p2 - end >>=? fun () -> - - - (* skip to testing period - -1 because we already baked one block with the ballot *) - Block.bake_n ((Int32.to_int blocks_per_voting_period)-1) b >>=? fun b -> - - Context.Vote.get_current_period_kind (B b) >>=? begin function - | Testing -> return_unit - | _ -> failwith "%s - Unexpected period kind" __LOC__ - end >>=? fun () -> - - (* period 2 *) - Context.Vote.get_voting_period (B b) >>=? fun v -> - let open Alpha_context in - Assert.equal ~loc:__LOC__ Voting_period.equal "Unexpected period" - Voting_period.pp v Voting_period.(succ (succ root)) - >>=? fun () -> - - (* no ballots in testing period *) - Context.Vote.get_ballots (B b) >>=? fun v -> - Assert.equal ~loc:__LOC__ ballots_equal "Unexpected ballots" ballots_pp - v ballots_zero >>=? fun () -> - - (* listings must be empty in testing period *) - Context.Vote.get_listings (B b) >>=? begin function - | [] -> return_unit - | _ -> failwith "%s - Unexpected listings" __LOC__ - end >>=? fun () -> - - - (* skip to promotion_vote period *) - Block.bake_n (Int32.to_int blocks_per_voting_period) b >>=? fun b -> - - Context.Vote.get_current_period_kind (B b) >>=? begin function - | Promotion_vote -> return_unit - | _ -> failwith "%s - Unexpected period kind" __LOC__ - end >>=? fun () -> - - (* period 3 *) - Context.Vote.get_voting_period (B b) >>=? fun v -> - let open Alpha_context in - Assert.equal ~loc:__LOC__ Voting_period.equal "Unexpected period" - Voting_period.pp v Voting_period.(succ (succ (succ root))) - >>=? fun () -> - - (* listings must be populated in promotion_vote period *) - Context.Vote.get_listings (B b) >>=? begin function - | [] -> failwith "%s - Unexpected empty listings" __LOC__ - | _ -> return_unit - end >>=? fun () -> - - (* beginning of promotion_vote period, denoted by _p4; - take a snapshot of the active delegates and their rolls from listings *) - get_delegates_and_rolls_from_listings b >>=? fun (delegates_p4, rolls_p4) -> - - (* no proposals during promotion_vote period *) - Context.Vote.get_proposals (B b) >>=? fun ps -> - begin if Environment.Protocol_hash.Map.is_empty ps - then return_unit - else failwith "%s - Unexpected proposals" __LOC__ - end >>=? fun () -> - - (* current proposal must be set during promotion_vote period *) - Context.Vote.get_current_proposal (B b) >>=? begin function - | Some v -> if Protocol_hash.(equal zero v) then return_unit - else failwith "%s - Wrong proposal" __LOC__ - | None -> failwith "%s - Missing proposal" __LOC__ - end >>=? fun () -> - - (* unanimous vote: all delegates --active when p4 started-- vote *) - map_s (fun del -> - Op.ballot (B b) del Protocol_hash.zero Vote.Yay) - delegates_p4 >>=? fun operations -> - Block.bake ~operations b >>=? fun b -> - - fold_left_s (fun v acc -> return Int32.(add v acc)) - 0l rolls_p4 >>=? fun rolls_sum -> - - (* # of Yays in ballots matches rolls of the delegate *) - Context.Vote.get_ballots (B b) >>=? fun v -> - Assert.equal ~loc:__LOC__ ballots_equal "Unexpected ballots" ballots_pp - v Vote.{ yay = rolls_sum ; nay = 0l ; pass = 0l } >>=? fun () -> - - (* One Yay ballot per delegate *) - Context.Vote.get_ballot_list (B b) >>=? begin function - | [] -> failwith "%s - Unexpected empty ballot list" __LOC__ - | l -> - iter_s (fun delegate -> - Context.Contract.pkh delegate >>=? fun pkh -> - match List.find_opt (fun (del,_) -> del = pkh) l with - | None -> failwith "%s - Missing delegate" __LOC__ - | Some (_, Vote.Yay) -> return_unit - | Some _ -> failwith "%s - Wrong ballot" __LOC__ - ) delegates_p4 - end >>=? fun () -> - - (* skip to end of promotion_vote period and activation*) - Block.bake_n Int32.((to_int blocks_per_voting_period)-1) b >>=? fun b -> - - (* zero is the new protocol (before the vote this value is unset) *) - Context.Vote.get_protocol b >>= fun p -> - Assert.equal ~loc:__LOC__ Protocol_hash.equal "Unexpected proposal" - Protocol_hash.pp p Protocol_hash.zero >>=? fun () -> - - return_unit - -(* given a list of active delegates, - return the first k active delegates with which one can have quorum, that is: - their roll sum divided by the total roll sum is bigger than pr_ema_weight/den *) -let get_smallest_prefix_voters_for_quorum active_delegates active_rolls = - fold_left_s (fun v acc -> return Int32.(add v acc)) - 0l active_rolls >>=? fun active_rolls_sum -> - let rec loop delegates rolls sum selected = - match delegates, rolls with - | [], [] -> selected - | del :: delegates, del_rolls :: rolls -> - if den * sum < Float.to_int (expected_qr_num *. (Int32.to_float active_rolls_sum)) then - loop delegates rolls (sum + (Int32.to_int del_rolls)) (del :: selected) - else selected - | _, _ -> [] in - return (loop active_delegates active_rolls 0 []) - -let get_expected_participation_ema rolls voter_rolls old_participation_ema = - (* formula to compute the updated participation_ema *) - let get_updated_participation_ema old_participation_ema participation = - (pr_ema_weight * (Int32.to_int old_participation_ema) + - pr_num * participation) / den - in - fold_left_s (fun v acc -> return Int32.(add v acc)) - 0l rolls >>=? fun rolls_sum -> - fold_left_s (fun v acc -> return Int32.(add v acc)) - 0l voter_rolls >>=? fun voter_rolls_sum -> - let participation = (Int32.to_int voter_rolls_sum) * percent_mul / - (Int32.to_int rolls_sum) in - return (get_updated_participation_ema old_participation_ema participation) - -(* if not enough quorum -- get_updated_participation_ema < pr_ema_weight/den -- in testing vote, - go back to proposal period *) -let test_not_enough_quorum_in_testing_vote num_delegates () = - let min_proposal_quorum = Int32.(of_int @@ 100_00 / num_delegates) in - Context.init ~min_proposal_quorum num_delegates >>=? fun (b,delegates) -> - Context.get_constants (B b) >>=? - fun { parametric = {blocks_per_voting_period ; _ } ; _ } -> - - (* proposal period *) - let open Alpha_context in - Context.Vote.get_current_period_kind (B b) >>=? begin function - | Proposal -> return_unit - | _ -> failwith "%s - Unexpected period kind" __LOC__ - end >>=? fun () -> - - let proposer = List.nth delegates 0 in - Op.proposals (B b) proposer [Protocol_hash.zero] >>=? fun ops -> - Block.bake ~operations:[ops] b >>=? fun b -> - - (* skip to vote_testing period - -1 because we already baked one block with the proposal *) - Block.bake_n ((Int32.to_int blocks_per_voting_period)-2) b >>=? fun b -> - - (* we moved to a testing_vote period with one proposal *) - Context.Vote.get_current_period_kind (B b) >>=? begin function - | Testing_vote -> return_unit - | _ -> failwith "%s - Unexpected period kind" __LOC__ - end >>=? fun () -> - - Context.Vote.get_participation_ema b >>=? fun initial_participation_ema -> - (* beginning of testing_vote period, denoted by _p2; - take a snapshot of the active delegates and their rolls from listings *) - get_delegates_and_rolls_from_listings b >>=? fun (delegates_p2, rolls_p2) -> - - get_smallest_prefix_voters_for_quorum delegates_p2 rolls_p2 >>=? fun voters -> - (* take the first two voters out so there cannot be quorum *) - let voters_without_quorum = List.tl voters in - get_rolls b voters_without_quorum __LOC__ >>=? fun voters_rolls_in_testing_vote -> - - (* all voters_without_quorum vote, for yays; - no nays, so supermajority is satisfied *) - map_s (fun del -> - Op.ballot (B b) del Protocol_hash.zero Vote.Yay) - voters_without_quorum >>=? fun operations -> - Block.bake ~operations b >>=? fun b -> - - (* skip to testing period *) - Block.bake_n ((Int32.to_int blocks_per_voting_period)-1) b >>=? fun b -> - - (* we move back to the proposal period because not enough quorum *) - Context.Vote.get_current_period_kind (B b) >>=? begin function - | Proposal -> return_unit - | _ -> failwith "%s - Unexpected period kind" __LOC__ - end >>=? fun () -> - - (* check participation_ema update *) - get_expected_participation_ema rolls_p2 - voters_rolls_in_testing_vote initial_participation_ema >>=? fun expected_participation_ema -> - Context.Vote.get_participation_ema b >>=? fun new_participation_ema -> - (* assert the formula to calculate participation_ema is correct *) - Assert.equal_int ~loc:__LOC__ expected_participation_ema - (Int32.to_int new_participation_ema) >>=? fun () -> - - return_unit - -(* if not enough quorum -- get_updated_participation_ema < pr_ema_weight/den -- in promotion vote, - go back to proposal period *) -let test_not_enough_quorum_in_promotion_vote num_delegates () = - let min_proposal_quorum = Int32.(of_int @@ 100_00 / num_delegates) in - Context.init ~min_proposal_quorum num_delegates >>=? fun (b,delegates) -> - Context.get_constants (B b) >>=? - fun { parametric = {blocks_per_voting_period ; _ } ; _ } -> - - Context.Vote.get_current_period_kind (B b) >>=? begin function - | Proposal -> return_unit - | _ -> failwith "%s - Unexpected period kind" __LOC__ - end >>=? fun () -> - - let proposer = List.nth delegates 0 in - Op.proposals (B b) proposer (Protocol_hash.zero::[]) >>=? fun ops -> - Block.bake ~operations:[ops] b >>=? fun b -> - - (* skip to vote_testing period - -1 because we already baked one block with the proposal *) - Block.bake_n ((Int32.to_int blocks_per_voting_period)-2) b >>=? fun b -> - - (* we moved to a testing_vote period with one proposal *) - Context.Vote.get_current_period_kind (B b) >>=? begin function - | Testing_vote -> return_unit - | _ -> failwith "%s - Unexpected period kind" __LOC__ - end >>=? fun () -> - - (* beginning of testing_vote period, denoted by _p2; - take a snapshot of the active delegates and their rolls from listings *) - get_delegates_and_rolls_from_listings b >>=? fun (delegates_p2, rolls_p2) -> - - get_smallest_prefix_voters_for_quorum delegates_p2 rolls_p2 >>=? fun voters -> - - let open Alpha_context in - - (* all voters vote, for yays; - no nays, so supermajority is satisfied *) - map_s (fun del -> - Op.ballot (B b) del Protocol_hash.zero Vote.Yay) - voters >>=? fun operations -> - - Block.bake ~operations b >>=? fun b -> - - (* skip to testing period *) - Block.bake_n ((Int32.to_int blocks_per_voting_period)-1) b >>=? fun b -> - - (* we move to testing because we have supermajority and enough quorum *) - Context.Vote.get_current_period_kind (B b) >>=? begin function - | Testing -> return_unit - | _ -> failwith "%s - Unexpected period kind" __LOC__ - end >>=? fun () -> - - (* skip to promotion_vote period *) - Block.bake_n (Int32.to_int blocks_per_voting_period) b >>=? fun b -> - - Context.Vote.get_current_period_kind (B b) >>=? begin function - | Promotion_vote -> return_unit - | _ -> failwith "%s - Unexpected period kind" __LOC__ - end >>=? fun () -> - - Context.Vote.get_participation_ema b >>=? fun initial_participation_ema -> - (* beginning of promotion period, denoted by _p4; - take a snapshot of the active delegates and their rolls from listings *) - get_delegates_and_rolls_from_listings b >>=? fun (delegates_p4, rolls_p4) -> - get_smallest_prefix_voters_for_quorum delegates_p4 rolls_p4 >>=? fun voters -> - - (* take the first voter out so there cannot be quorum *) - let voters_without_quorum = List.tl voters in - get_rolls b voters_without_quorum __LOC__ >>=? fun voter_rolls -> - - (* all voters_without_quorum vote, for yays; - no nays, so supermajority is satisfied *) - map_s (fun del -> - Op.ballot (B b) del Protocol_hash.zero Vote.Yay) - voters_without_quorum >>=? fun operations -> - Block.bake ~operations b >>=? fun b -> - - (* skip to end of promotion_vote period *) - Block.bake_n ((Int32.to_int blocks_per_voting_period)-1) b >>=? fun b -> - - get_expected_participation_ema rolls_p4 voter_rolls - initial_participation_ema >>=? fun expected_participation_ema -> - - Context.Vote.get_participation_ema b >>=? fun new_participation_ema -> - - (* assert the formula to calculate participation_ema is correct *) - Assert.equal_int ~loc:__LOC__ expected_participation_ema - (Int32.to_int new_participation_ema) >>=? fun () -> - - (* we move back to the proposal period because not enough quorum *) - Context.Vote.get_current_period_kind (B b) >>=? begin function - | Proposal -> return_unit - | _ -> failwith "%s - Unexpected period kind" __LOC__ - end >>=? fun () -> - - return_unit - -let test_multiple_identical_proposals_count_as_one () = - Context.init 1 >>=? fun (b,delegates) -> - - Context.Vote.get_current_period_kind (B b) >>=? begin function - | Proposal -> return_unit - | _ -> failwith "%s - Unexpected period kind" __LOC__ - end >>=? fun () -> - - let proposer = List.hd delegates in - Op.proposals (B b) proposer - [Protocol_hash.zero; Protocol_hash.zero] >>=? fun ops -> - Block.bake ~operations:[ops] b >>=? fun b -> - (* compute the weight of proposals *) - Context.Vote.get_proposals (B b) >>=? fun ps -> - - (* compute the rolls of proposer *) - Context.Contract.pkh proposer >>=? fun pkh -> - Context.Vote.get_listings (B b) >>=? fun l -> - begin match List.find_opt (fun (del,_) -> del = pkh) l with - | None -> failwith "%s - Missing delegate" __LOC__ - | Some (_, proposer_rolls) -> return proposer_rolls - end >>=? fun proposer_rolls -> - - (* correctly count the double proposal for zero as one proposal *) - let expected_weight_proposer = proposer_rolls in - match Environment.Protocol_hash.(Map.find_opt zero ps) with - | Some v -> if v = expected_weight_proposer then return_unit - else failwith - "%s - Wrong count %ld is not %ld; identical proposals count as one" - __LOC__ v expected_weight_proposer - | None -> failwith "%s - Missing proposal" __LOC__ - - -(* assumes the initial balance of allocated by Context.init is at - least 4 time the value of the tokens_per_roll constant *) -let test_supermajority_in_proposal there_is_a_winner () = - let min_proposal_quorum = 0l in - Context.init ~min_proposal_quorum ~initial_balances:[1L; 1L; 1L] 10 >>=? fun (b,delegates) -> - Context.get_constants (B b) - >>=? fun { parametric = {blocks_per_cycle; blocks_per_voting_period; tokens_per_roll; _ } ; _ } -> - - let del1 = List.nth delegates 0 in - let del2 = List.nth delegates 1 in - let del3 = List.nth delegates 2 in - - map_s (fun del -> Context.Contract.pkh del) [del1; del2; del3] >>=? fun pkhs -> - let policy = Block.Excluding pkhs in - - Op.transaction (B b) (List.nth delegates 3) del1 tokens_per_roll >>=? fun op1 -> - Op.transaction (B b) (List.nth delegates 4) del2 tokens_per_roll >>=? fun op2 -> - begin - if there_is_a_winner - then Test_tez.Tez.( *? ) tokens_per_roll 3L - else Test_tez.Tez.( *? ) tokens_per_roll 2L - end >>?= fun bal3 -> - Op.transaction (B b) (List.nth delegates 5) del3 bal3 >>=? fun op3 -> - - Block.bake ~policy ~operations:[op1; op2; op3] b >>=? fun b -> - - (* we let one voting period pass; we make sure that: - - the three selected delegates remain active by re-registering as delegates - - their number of rolls do not change *) - fold_left_s (fun b _ -> - Error_monad.map_s (fun del -> - Context.Contract.pkh del >>=? fun pkh -> - Op.delegation (B b) del (Some pkh) - ) delegates >>=? fun ops -> - Block.bake ~policy ~operations:ops b >>=? fun b -> - Block.bake_until_cycle_end ~policy b - ) b (1 -- - (Int32.to_int (Int32.div blocks_per_voting_period blocks_per_cycle))) >>=? fun b -> - - (* make the proposals *) - Op.proposals (B b) del1 [protos.(0)] >>=? fun ops1 -> - Op.proposals (B b) del2 [protos.(0)] >>=? fun ops2 -> - Op.proposals (B b) del3 [protos.(1)] >>=? fun ops3 -> - Block.bake ~policy ~operations:[ops1;ops2;ops3] b >>=? fun b -> - Block.bake_n ~policy ((Int32.to_int blocks_per_voting_period)-1) b >>=? fun b -> - - (* we remain in the proposal period when there is no winner, - otherwise we move to the testing vote period *) - Context.Vote.get_current_period_kind (B b) >>=? begin function - | Testing_vote -> - if there_is_a_winner then return_unit - else failwith "%s - Expected period kind Proposal, obtained Testing_vote" __LOC__ - | Proposal -> - if not there_is_a_winner then return_unit - else failwith "%s - Expected period kind Testing_vote, obtained Proposal" __LOC__ - | _ -> failwith "%s - Unexpected period kind" __LOC__ - end >>=? fun () -> - - return_unit - - -let test_quorum_in_proposal has_quorum () = - let total_tokens = 32_000_000_000_000L in - let half_tokens = Int64.div total_tokens 2L in - Context.init - ~initial_balances:[1L; half_tokens; half_tokens] - 3 >>=? fun (b,delegates) -> - Context.get_constants (B b) >>=? fun { - parametric = { - blocks_per_cycle; - blocks_per_voting_period; - min_proposal_quorum; _ } ; _ } -> - - let del1 = List.nth delegates 0 in - let del2 = List.nth delegates 1 in - - map_s (fun del -> Context.Contract.pkh del) [del1; del2] >>=? fun pkhs -> - let policy = Block.Excluding pkhs in - - let quorum = - if has_quorum then - Int64.of_int32 min_proposal_quorum - else - Int64.(sub (of_int32 min_proposal_quorum) 10L) in - let bal = - Int64.(div (mul total_tokens quorum) 100_00L) - |> Test_tez.Tez.of_mutez_exn in - Op.transaction (B b) del2 del1 bal >>=? fun op2 -> - Block.bake ~policy ~operations:[op2] b >>=? fun b -> - - (* we let one voting period pass; we make sure that: - - the two selected delegates remain active by re-registering as delegates - - their number of rolls do not change *) - fold_left_s (fun b _ -> - Error_monad.map_s (fun del -> - Context.Contract.pkh del >>=? fun pkh -> - Op.delegation (B b) del (Some pkh) - ) [del1;del2] >>=? fun ops -> - Block.bake ~policy ~operations:ops b >>=? fun b -> - Block.bake_until_cycle_end ~policy b - ) b (1 -- - (Int32.to_int (Int32.div blocks_per_voting_period blocks_per_cycle))) >>=? fun b -> - - (* make the proposal *) - Op.proposals (B b) del1 [protos.(0)] >>=? fun ops -> - Block.bake ~policy ~operations:[ops] b >>=? fun b -> - Block.bake_n ~policy ((Int32.to_int blocks_per_voting_period)-1) b >>=? fun b -> - - (* we remain in the proposal period when there is no quorum, - otherwise we move to the testing vote period *) - Context.Vote.get_current_period_kind (B b) >>=? begin function - | Testing_vote -> - if has_quorum then return_unit - else failwith "%s - Expected period kind Proposal, obtained Testing_vote" __LOC__ - | Proposal -> - if not has_quorum then return_unit - else failwith "%s - Expected period kind Testing_vote, obtained Proposal" __LOC__ - | _ -> failwith "%s - Unexpected period kind" __LOC__ - end >>=? fun () -> - - return_unit - - -let test_supermajority_in_testing_vote supermajority () = - let min_proposal_quorum = Int32.(of_int @@ 100_00 / 100) in - Context.init ~min_proposal_quorum 100 >>=? fun (b,delegates) -> - Context.get_constants (B b) >>=? - fun { parametric = {blocks_per_voting_period ; _ } ; _ } -> - - let del1 = List.nth delegates 0 in - let proposal = protos.(0) in - - Op.proposals (B b) del1 [proposal] >>=? fun ops1 -> - Block.bake ~operations:[ops1] b >>=? fun b -> - Block.bake_n ((Int32.to_int blocks_per_voting_period)-1) b >>=? fun b -> - - (* move to testing_vote *) - Context.Vote.get_current_period_kind (B b) >>=? begin function - | Testing_vote -> return_unit - | _ -> failwith "%s - Unexpected period kind" __LOC__ - end >>=? fun () -> - - (* assert our proposal won *) - Context.Vote.get_current_proposal (B b) >>=? begin function - | Some v -> if Protocol_hash.(equal proposal v) then return_unit - else failwith "%s - Wrong proposal" __LOC__ - | None -> failwith "%s - Missing proposal" __LOC__ - end >>=? fun () -> - - (* beginning of testing_vote period, denoted by _p2; - take a snapshot of the active delegates and their rolls from listings *) - get_delegates_and_rolls_from_listings b >>=? fun (delegates_p2, _olls_p2) -> - - (* supermajority means [num_yays / (num_yays + num_nays) >= s_num / s_den], - which is equivalent with [num_yays >= num_nays * s_num / (s_den - s_num)] *) - let num_delegates = List.length delegates_p2 in - let num_nays = num_delegates / 5 in (* any smaller number will do as well *) - let num_yays = num_nays * s_num / (s_den - s_num) in - (* majority/minority vote depending on the [supermajority] parameter *) - let num_yays = if supermajority then num_yays else num_yays - 1 in - - let open Alpha_context in - - let nays_delegates, rest = List.split_n num_nays delegates_p2 in - let yays_delegates, _ = List.split_n num_yays rest in - map_s (fun del -> - Op.ballot (B b) del proposal Vote.Yay) - yays_delegates >>=? fun operations_yays -> - map_s (fun del -> - Op.ballot (B b) del proposal Vote.Nay) - nays_delegates >>=? fun operations_nays -> - let operations = operations_yays @ operations_nays in - - Block.bake ~operations b >>=? fun b -> - Block.bake_n ((Int32.to_int blocks_per_voting_period)-1) b >>=? fun b -> - - Context.Vote.get_current_period_kind (B b) >>=? begin function - | Testing -> - if supermajority then return_unit - else failwith "%s - Expected period kind Proposal, obtained Testing" __LOC__ - | Proposal -> - if not supermajority then return_unit - else failwith "%s - Expected period kind Testing_vote, obtained Proposal" __LOC__ - | _ -> failwith "%s - Unexpected period kind" __LOC__ - end >>=? fun () -> - - return_unit - -(* test also how the selection scales: all delegates propose max proposals *) -let test_no_winning_proposal num_delegates () = - let min_proposal_quorum = Int32.(of_int @@ 100_00 / num_delegates) in - Context.init ~min_proposal_quorum num_delegates >>=? fun (b,_) -> - Context.get_constants (B b) >>=? - fun { parametric = {blocks_per_voting_period ; _ } ; _ } -> - - (* beginning of proposal, denoted by _p1; - take a snapshot of the active delegates and their rolls from listings *) - get_delegates_and_rolls_from_listings b >>=? fun (delegates_p1, _rolls_p1) -> - - let open Alpha_context in - let props = List.map (fun i -> protos.(i)) - (1 -- Constants.max_proposals_per_delegate) in - (* all delegates active in p1 propose the same proposals *) - map_s - (fun del -> Op.proposals (B b) del props) - delegates_p1 >>=? fun ops_list -> - Block.bake ~operations:ops_list b >>=? fun b -> - - (* skip to testing_vote period - -1 because we already baked one block with the proposal *) - Block.bake_n ((Int32.to_int blocks_per_voting_period)-2) b >>=? fun b -> - - (* we stay in the same proposal period because no winning proposal *) - Context.Vote.get_current_period_kind (B b) >>=? begin function - | Proposal -> return_unit - | _ -> failwith "%s - Unexpected period kind" __LOC__ - end >>=? fun () -> - - return_unit - -(** Test that for the vote to pass with maximum possible participation_ema - (100%), it is sufficient for the vote quorum to be equal or greater than - the maximum quorum cap. *) -let test_quorum_capped_maximum num_delegates () = - let min_proposal_quorum = Int32.(of_int @@ 100_00 / num_delegates) in - Context.init ~min_proposal_quorum num_delegates >>=? fun (b,delegates) -> - (* set the participation EMA to 100% *) - Context.Vote.set_participation_ema b 100_00l >>= fun b -> - Context.get_constants (B b) >>=? - fun { parametric = { blocks_per_voting_period ; quorum_max ; _ } ; _ } -> - - (* proposal period *) - let open Alpha_context in - Context.Vote.get_current_period_kind (B b) >>=? begin function - | Proposal -> return_unit - | _ -> failwith "%s - Unexpected period kind" __LOC__ - end >>=? fun () -> - - (* propose a new protocol *) - let protocol = Protocol_hash.zero in - let proposer = List.nth delegates 0 in - Op.proposals (B b) proposer [protocol] >>=? fun ops -> - Block.bake ~operations:[ops] b >>=? fun b -> - - (* skip to vote_testing period - -1 because we already baked one block with the proposal *) - Block.bake_n ((Int32.to_int blocks_per_voting_period)-1) b >>=? fun b -> - - (* we moved to a testing_vote period with one proposal *) - Context.Vote.get_current_period_kind (B b) >>=? begin function - | Testing_vote -> return_unit - | _ -> failwith "%s - Unexpected period kind" __LOC__ - end >>=? fun () -> - - (* take percentage of the delegates equal or greater than quorum_max *) - let minimum_to_pass = - Float.of_int (List.length delegates) *. Int32.(to_float quorum_max) /. 100_00. - |> Float.ceil - |> Float.to_int - in - let voters = List.take_n minimum_to_pass delegates in - (* all voters vote for yays; no nays, so supermajority is satisfied *) - map_s (fun del -> - Op.ballot (B b) del protocol Vote.Yay) - voters >>=? fun operations -> - Block.bake ~operations b >>=? fun b -> - - (* skip to next period *) - Block.bake_n ((Int32.to_int blocks_per_voting_period)-1) b >>=? fun b -> - - (* expect to move to testing because we have supermajority and enough quorum *) - Context.Vote.get_current_period_kind (B b) >>=? begin function - | Testing -> return_unit - | _ -> failwith "%s - Unexpected period kind" __LOC__ - end - -(** Test that for the vote to pass with minimum possible participation_ema - (0%), it is sufficient for the vote quorum to be equal or greater than - the minimum quorum cap. *) -let test_quorum_capped_minimum num_delegates () = - let min_proposal_quorum = Int32.(of_int @@ 100_00 / num_delegates) in - Context.init ~min_proposal_quorum num_delegates >>=? fun (b,delegates) -> - (* set the participation EMA to 0% *) - Context.Vote.set_participation_ema b 0l >>= fun b -> - Context.get_constants (B b) >>=? - fun { parametric = { blocks_per_voting_period ; quorum_min ; _ } ; _ } -> - - (* proposal period *) - let open Alpha_context in - Context.Vote.get_current_period_kind (B b) >>=? begin function - | Proposal -> return_unit - | _ -> failwith "%s - Unexpected period kind" __LOC__ - end >>=? fun () -> - - (* propose a new protocol *) - let protocol = Protocol_hash.zero in - let proposer = List.nth delegates 0 in - Op.proposals (B b) proposer [protocol] >>=? fun ops -> - Block.bake ~operations:[ops] b >>=? fun b -> - - (* skip to vote_testing period - -1 because we already baked one block with the proposal *) - Block.bake_n ((Int32.to_int blocks_per_voting_period)-1) b >>=? fun b -> - - (* we moved to a testing_vote period with one proposal *) - Context.Vote.get_current_period_kind (B b) >>=? begin function - | Testing_vote -> return_unit - | _ -> failwith "%s - Unexpected period kind" __LOC__ - end >>=? fun () -> - - (* take percentage of the delegates equal or greater than quorum_min *) - let minimum_to_pass = - Float.of_int (List.length delegates) *. Int32.(to_float quorum_min) /. 100_00. - |> Float.ceil - |> Float.to_int - in - let voters = List.take_n minimum_to_pass delegates in - (* all voters vote for yays; no nays, so supermajority is satisfied *) - map_s (fun del -> - Op.ballot (B b) del protocol Vote.Yay) - voters >>=? fun operations -> - Block.bake ~operations b >>=? fun b -> - - (* skip to next period *) - Block.bake_n ((Int32.to_int blocks_per_voting_period)-1) b >>=? fun b -> - - (* expect to move to testing because we have supermajority and enough quorum *) - Context.Vote.get_current_period_kind (B b) >>=? begin function - | Testing -> return_unit - | _ -> failwith "%s - Unexpected period kind" __LOC__ - end - -let tests = [ - Test.tztest "voting successful_vote" `Quick (test_successful_vote 137) ; - Test.tztest "voting testing vote, not enough quorum" `Quick (test_not_enough_quorum_in_testing_vote 245) ; - Test.tztest "voting promotion vote, not enough quorum" `Quick (test_not_enough_quorum_in_promotion_vote 432) ; - Test.tztest "voting counting double proposal" `Quick test_multiple_identical_proposals_count_as_one; - Test.tztest "voting proposal, with supermajority" `Quick (test_supermajority_in_proposal true) ; - Test.tztest "voting proposal, without supermajority" `Quick (test_supermajority_in_proposal false) ; - Test.tztest "voting proposal, with quorum" `Quick (test_quorum_in_proposal true) ; - Test.tztest "voting proposal, without quorum" `Quick (test_quorum_in_proposal false) ; - Test.tztest "voting testing vote, with supermajority" `Quick (test_supermajority_in_testing_vote true) ; - Test.tztest "voting testing vote, without supermajority" `Quick (test_supermajority_in_testing_vote false) ; - Test.tztest "voting proposal, no winning proposal" `Quick (test_no_winning_proposal 400) ; - Test.tztest "voting quorum, quorum capped maximum" `Quick (test_quorum_capped_maximum 400) ; - Test.tztest "voting quorum, quorum capped minimum" `Quick (test_quorum_capped_minimum 401) ; -] diff --git a/vendors/ligo-utils/tezos-protocol-alpha/tezos-protocol-005-PsBabyM1-tests.opam b/vendors/ligo-utils/tezos-protocol-alpha/tezos-protocol-005-PsBabyM1-tests.opam deleted file mode 100644 index 59f78ff77..000000000 --- a/vendors/ligo-utils/tezos-protocol-alpha/tezos-protocol-005-PsBabyM1-tests.opam +++ /dev/null @@ -1,32 +0,0 @@ -opam-version: "2.0" -maintainer: "contact@tezos.com" -authors: [ "Tezos devteam" ] -homepage: "https://www.tezos.com/" -bug-reports: "https://gitlab.com/tezos/tezos/issues" -dev-repo: "git+https://gitlab.com/tezos/tezos.git" -license: "MIT" -depends: [ - "tezos-tooling" { with-test } - "ocamlfind" { build } - "dune" { build & >= "1.7" } - "tezos-base" - "tezos-protocol-compiler" - "alcotest-lwt" { with-test } - "tezos-005-PsBabyM1-test-helpers" { with-test } - "tezos-stdlib-unix" { with-test } - "tezos-protocol-environment" { with-test } - "tezos-protocol-005-PsBabyM1-parameters" { with-test } - "tezos-shell-services" { with-test } - "bip39" { with-test } -] -build: [ - [ - "%{tezos-protocol-compiler:lib}%/replace" - "%{tezos-protocol-compiler:lib}%/dune_protocol.template" - "dune" - "005_PsBabyM1" - ] - ["dune" "build" "-p" name "-j" jobs] - ["dune" "runtest" "-p" name "-j" jobs] {with-test} -] -synopsis: "Tezos/Protocol: tests for economic-protocol definition" From ba7a83d0f7d516d663a6833cc16b85187a55c1e9 Mon Sep 17 00:00:00 2001 From: Tom Jack Date: Sat, 2 Nov 2019 17:54:33 -0500 Subject: [PATCH 3/3] Deal with upstream MBytes changes --- src/passes/8-compiler/compiler_program.ml | 2 +- src/passes/8-compiler/uncompiler.ml | 2 +- vendors/ligo-utils/tezos-utils/x_michelson.ml | 1 - 3 files changed, 2 insertions(+), 3 deletions(-) diff --git a/src/passes/8-compiler/compiler_program.ml b/src/passes/8-compiler/compiler_program.ml index 5ec9d7a7c..6f033acc6 100644 --- a/src/passes/8-compiler/compiler_program.ml +++ b/src/passes/8-compiler/compiler_program.ml @@ -68,7 +68,7 @@ let rec translate_value (v:value) ty : michelson result = match v with | D_timestamp n -> ok @@ int (Z.of_int n) | D_mutez n -> ok @@ int (Z.of_int n) | D_string s -> ok @@ string s - | D_bytes s -> ok @@ bytes (Tezos_stdlib.MBytes.of_bytes s) + | D_bytes s -> ok @@ bytes s | D_unit -> ok @@ prim D_Unit | D_pair (a, b) -> ( let%bind (a_ty , b_ty) = get_t_pair ty in diff --git a/src/passes/8-compiler/uncompiler.ml b/src/passes/8-compiler/uncompiler.ml index 3e28f4db8..0ec7e8320 100644 --- a/src/passes/8-compiler/uncompiler.ml +++ b/src/passes/8-compiler/uncompiler.ml @@ -46,7 +46,7 @@ let rec translate_value ?bm_opt (Ex_typed_value (ty, value)) : value result = | (String_t _), s -> ok @@ D_string s | (Bytes_t _), b -> - ok @@ D_bytes (Tezos_stdlib.MBytes.to_bytes b) + ok @@ D_bytes b | (Address_t _), (s , _) -> ok @@ D_string (Alpha_context.Contract.to_b58check s) | (Unit_t _), () -> diff --git a/vendors/ligo-utils/tezos-utils/x_michelson.ml b/vendors/ligo-utils/tezos-utils/x_michelson.ml index 8f20e8c30..8e0654317 100644 --- a/vendors/ligo-utils/tezos-utils/x_michelson.ml +++ b/vendors/ligo-utils/tezos-utils/x_michelson.ml @@ -103,6 +103,5 @@ let pp_json ppf (michelson : michelson) = let pp_hex ppf (michelson : michelson) = let canonical = strip_locations michelson in let bytes = Tezos_data_encoding.Binary_writer.to_bytes_exn Script_repr.expr_encoding canonical in - let bytes = Tezos_stdlib.MBytes.to_bytes bytes in let hex = Hex.of_bytes bytes in Format.fprintf ppf "%a" Hex.pp hex