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

Merge branch 'clean-sts-solver' of gitlab.com:ligolang/ligo into clean-sts-solver

Browse Source
This commit is contained in:
Suzanne Dupéron 2019-11-04 18:44:09 +00:00
commit 4325ba7ee4
41 changed files with 5 additions and 7412 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/passes/8-compiler/compiler_program.ml
View File

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

2
src/passes/8-compiler/uncompiler.ml
View File

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

1
src/passes/operators/operators.ml
View File

@ -76,6 +76,7 @@ module Simplify = struct
("string_slice" , "SLICE") ;
("bytes_concat" , "CONCAT") ;
("bytes_slice" , "SLICE") ;
("bytes_pack" , "PACK") ;
("set_empty" , "SET_EMPTY") ;
("set_mem" , "SET_MEM") ;
("set_add" , "SET_ADD") ;

5
vendors/ligo-utils/proto-alpha-utils/proto-alpha-utils.opam vendored
View File

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

371
vendors/ligo-utils/tezos-protocol-alpha/test/activation.ml vendored
View File

@ -1,371 +0,0 @@
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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
]

98
vendors/ligo-utils/tezos-protocol-alpha/test/baking.ml vendored
View File

@ -1,98 +0,0 @@
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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) ;
]

229
vendors/ligo-utils/tezos-protocol-alpha/test/combined_operations.ml vendored
View File

@ -1,229 +0,0 @@
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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 ;
]

16
vendors/ligo-utils/tezos-protocol-alpha/test/contracts/cps_fact.tz vendored
View File

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

14
vendors/ligo-utils/tezos-protocol-alpha/test/contracts/cps_fact_2.tz vendored
View File

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

1171
vendors/ligo-utils/tezos-protocol-alpha/test/delegation.ml vendored
View File

File diff suppressed because it is too large Load Diff

189
vendors/ligo-utils/tezos-protocol-alpha/test/double_baking.ml vendored
View File

@ -1,189 +0,0 @@
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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 ;
]

204
vendors/ligo-utils/tezos-protocol-alpha/test/double_endorsement.ml vendored
View File

@ -1,204 +0,0 @@
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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 ;
]

46
vendors/ligo-utils/tezos-protocol-alpha/test/dune vendored
View File

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

441
vendors/ligo-utils/tezos-protocol-alpha/test/endorsement.ml vendored
View File

@ -1,441 +0,0 @@
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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 ;
]

92
vendors/ligo-utils/tezos-protocol-alpha/test/helpers/account.ml vendored
View File

@ -1,92 +0,0 @@
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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 })

57
vendors/ligo-utils/tezos-protocol-alpha/test/helpers/account.mli vendored
View File

@ -1,57 +0,0 @@
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

124
vendors/ligo-utils/tezos-protocol-alpha/test/helpers/assert.ml vendored
View File

@ -1,124 +0,0 @@
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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)

418
vendors/ligo-utils/tezos-protocol-alpha/test/helpers/block.ml vendored
View File

@ -1,418 +0,0 @@
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

137
vendors/ligo-utils/tezos-protocol-alpha/test/helpers/block.mli vendored
View File

@ -1,137 +0,0 @@
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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 <opts> accounts] : generates an initial block with the
given constants [<opts>] 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

285
vendors/ligo-utils/tezos-protocol-alpha/test/helpers/context.ml vendored
View File

@ -1,285 +0,0 @@
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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)

119
vendors/ligo-utils/tezos-protocol-alpha/test/helpers/context.mli vendored
View File

@ -1,119 +0,0 @@
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

19
vendors/ligo-utils/tezos-protocol-alpha/test/helpers/dune vendored
View File

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

188
vendors/ligo-utils/tezos-protocol-alpha/test/helpers/incremental.ml vendored
View File

@ -1,188 +0,0 @@
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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 ;
}

51
vendors/ligo-utils/tezos-protocol-alpha/test/helpers/incremental.mli vendored
View File

@ -1,51 +0,0 @@
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

33
vendors/ligo-utils/tezos-protocol-alpha/test/helpers/nonce.ml vendored
View File

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

31
vendors/ligo-utils/tezos-protocol-alpha/test/helpers/nonce.mli vendored
View File

@ -1,31 +0,0 @@
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

337
vendors/ligo-utils/tezos-protocol-alpha/test/helpers/op.ml vendored
View File

@ -1,337 +0,0 @@
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

114
vendors/ligo-utils/tezos-protocol-alpha/test/helpers/op.mli vendored
View File

@ -1,114 +0,0 @@
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

61
vendors/ligo-utils/tezos-protocol-alpha/test/helpers/test_tez.ml vendored
View File

@ -1,61 +0,0 @@
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

43
vendors/ligo-utils/tezos-protocol-alpha/test/helpers/test_utils.ml vendored
View File

@ -1,43 +0,0 @@
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

21
vendors/ligo-utils/tezos-protocol-alpha/test/helpers/tezos-005-PsBabyM1-test-helpers.opam vendored
View File

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

41
vendors/ligo-utils/tezos-protocol-alpha/test/main.ml vendored
View File

@ -1,41 +0,0 @@
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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 ;
]

235
vendors/ligo-utils/tezos-protocol-alpha/test/origination.ml vendored
View File

@ -1,235 +0,0 @@
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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;
]

141
vendors/ligo-utils/tezos-protocol-alpha/test/qty.ml vendored
View File

@ -1,141 +0,0 @@
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

250
vendors/ligo-utils/tezos-protocol-alpha/test/rolls.ml vendored
View File

@ -1,250 +0,0 @@
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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) ;
]

223
vendors/ligo-utils/tezos-protocol-alpha/test/seed.ml vendored
View File

@ -1,223 +0,0 @@
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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 ;
]

35
vendors/ligo-utils/tezos-protocol-alpha/test/test.ml vendored
View File

@ -1,35 +0,0 @@
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

597
vendors/ligo-utils/tezos-protocol-alpha/test/transfer.ml vendored
View File

@ -1,597 +0,0 @@
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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 ;
]

943
vendors/ligo-utils/tezos-protocol-alpha/test/voting.ml vendored
View File

@ -1,943 +0,0 @@
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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) ;
]

32
vendors/ligo-utils/tezos-protocol-alpha/tezos-protocol-005-PsBabyM1-tests.opam vendored
View File

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

1
vendors/ligo-utils/tezos-utils/x_michelson.ml vendored
View File

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