Alpha: remove slots from endorsements
This commit is contained in:
parent
41707f58d8
commit
1ab9a7a72c
@ -187,10 +187,10 @@ test:p2p:banned_peers:
|
|||||||
# script:
|
# script:
|
||||||
# - jbuilder build @src/proto_alpha/lib_delegate/runtest_origination
|
# - jbuilder build @src/proto_alpha/lib_delegate/runtest_origination
|
||||||
|
|
||||||
test:client_alpha:endorsement:
|
# test:client_alpha:endorsement:
|
||||||
<<: *test_definition
|
# <<: *test_definition
|
||||||
script:
|
# script:
|
||||||
- jbuilder build @src/proto_alpha/lib_delegate/runtest_endorsement
|
# - jbuilder build @src/proto_alpha/lib_baking/runtest_endorsement
|
||||||
|
|
||||||
test:client_alpha:vote:
|
test:client_alpha:vote:
|
||||||
<<: *test_definition
|
<<: *test_definition
|
||||||
|
@ -42,7 +42,7 @@ let preapply (type t)
|
|||||||
({ branch }, Contents_list contents) in
|
({ branch }, Contents_list contents) in
|
||||||
let watermark =
|
let watermark =
|
||||||
match contents with
|
match contents with
|
||||||
| Single (Endorsements _) -> Signature.Endorsement
|
| Single (Endorsement _) -> Signature.Endorsement
|
||||||
| _ -> Signature.Generic_operation in
|
| _ -> Signature.Generic_operation in
|
||||||
begin
|
begin
|
||||||
match src_sk with
|
match src_sk with
|
||||||
|
@ -300,8 +300,8 @@ let rec pp_contents_and_result_list :
|
|||||||
Ed25519.Public_key_hash.pp id
|
Ed25519.Public_key_hash.pp id
|
||||||
pp_balance_updates bus
|
pp_balance_updates bus
|
||||||
| Single_and_result
|
| Single_and_result
|
||||||
(Endorsements { block ; level ; slots },
|
(Endorsement { block ; level },
|
||||||
Endorsements_result (delegate, _slots)) ->
|
Endorsement_result (delegate, slots)) ->
|
||||||
Format.fprintf ppf
|
Format.fprintf ppf
|
||||||
"@[<v 2>Endorsement:@,\
|
"@[<v 2>Endorsement:@,\
|
||||||
Block: %a@,\
|
Block: %a@,\
|
||||||
|
@ -25,13 +25,11 @@ let get_signing_slots cctxt ?(chain = `Main) block delegate level =
|
|||||||
let inject_endorsement
|
let inject_endorsement
|
||||||
(cctxt : #Proto_alpha.full)
|
(cctxt : #Proto_alpha.full)
|
||||||
?(chain = `Main) block hash level ?async
|
?(chain = `Main) block hash level ?async
|
||||||
src_sk slots pkh =
|
src_sk pkh =
|
||||||
Alpha_services.Forge.endorsement cctxt
|
Alpha_services.Forge.endorsement cctxt
|
||||||
(chain, block)
|
(chain, block)
|
||||||
~branch:hash
|
~branch:hash
|
||||||
~block:hash
|
|
||||||
~level:level
|
~level:level
|
||||||
~slots
|
|
||||||
() >>=? fun bytes ->
|
() >>=? fun bytes ->
|
||||||
Client_keys.append cctxt
|
Client_keys.append cctxt
|
||||||
src_sk ~watermark:Endorsement bytes >>=? fun signed_bytes ->
|
src_sk ~watermark:Endorsement bytes >>=? fun signed_bytes ->
|
||||||
@ -77,13 +75,15 @@ let forge_endorsement (cctxt : #Proto_alpha.full)
|
|||||||
| Some slots -> return slots
|
| Some slots -> return slots
|
||||||
end >>=? fun slots ->
|
end >>=? fun slots ->
|
||||||
Shell_services.Blocks.hash cctxt ~chain ~block () >>=? fun hash ->
|
Shell_services.Blocks.hash cctxt ~chain ~block () >>=? fun hash ->
|
||||||
inject_endorsement cctxt ~chain ?async block hash level src_sk slots src_pkh >>=? fun oph ->
|
inject_endorsement cctxt ~chain ?async block hash level src_sk src_pkh >>=? fun oph ->
|
||||||
Client_keys.get_key cctxt src_pkh >>=? fun (name, _pk, _sk) ->
|
Client_keys.get_key cctxt src_pkh >>=? fun (name, _pk, _sk) ->
|
||||||
cctxt#message
|
cctxt#message
|
||||||
"Injected endorsement level %a, contract %s '%a'"
|
"Injected endorsement level %a, contract %s '%a', slots @[<h>%a@]"
|
||||||
Raw_level.pp level
|
Raw_level.pp level
|
||||||
name
|
name
|
||||||
Operation_hash.pp_short oph >>=
|
Operation_hash.pp_short oph
|
||||||
|
(Format.pp_print_list Format.pp_print_int) slots
|
||||||
|
>>=
|
||||||
fun () -> return oph
|
fun () -> return oph
|
||||||
|
|
||||||
(** Worker *)
|
(** Worker *)
|
||||||
@ -124,7 +124,7 @@ let endorse_for_delegate cctxt { delegate ; block ; slots ; } =
|
|||||||
(List.length slots) >>= fun () ->
|
(List.length slots) >>= fun () ->
|
||||||
inject_endorsement cctxt
|
inject_endorsement cctxt
|
||||||
b hash level
|
b hash level
|
||||||
sk slots delegate >>=? fun oph ->
|
sk delegate >>=? fun oph ->
|
||||||
lwt_log_info
|
lwt_log_info
|
||||||
"Injected endorsement for block '%a' \
|
"Injected endorsement for block '%a' \
|
||||||
(level %a, contract %s) '%a'"
|
(level %a, contract %s) '%a'"
|
||||||
|
@ -1,8 +1,7 @@
|
|||||||
(jbuild_version 1)
|
(jbuild_version 1)
|
||||||
|
|
||||||
(executables
|
(executables
|
||||||
((names (test_endorsement
|
((names (test_michelson_parser
|
||||||
test_michelson_parser
|
|
||||||
test_origination
|
test_origination
|
||||||
test_transaction
|
test_transaction
|
||||||
test_rpc
|
test_rpc
|
||||||
@ -29,18 +28,12 @@
|
|||||||
|
|
||||||
(alias
|
(alias
|
||||||
((name buildtest)
|
((name buildtest)
|
||||||
(deps (test_endorsement.exe
|
(deps (test_michelson_parser.exe
|
||||||
test_michelson_parser.exe
|
|
||||||
;test_origination.exe
|
;test_origination.exe
|
||||||
;test_transaction.exe
|
;test_transaction.exe
|
||||||
test_rpc.exe
|
test_rpc.exe
|
||||||
test_vote.exe))))
|
test_vote.exe))))
|
||||||
|
|
||||||
(alias
|
|
||||||
((name runtest_endorsement)
|
|
||||||
(locks (/tcp-port/18100))
|
|
||||||
(action (chdir ${ROOT} (run ${exe:test_endorsement.exe} ${bin:tezos-node} 18100)))))
|
|
||||||
|
|
||||||
(alias
|
(alias
|
||||||
((name runtest_michelson_parser)
|
((name runtest_michelson_parser)
|
||||||
(action (run ${exe:test_michelson_parser.exe}))))
|
(action (run ${exe:test_michelson_parser.exe}))))
|
||||||
@ -67,8 +60,7 @@
|
|||||||
|
|
||||||
(alias
|
(alias
|
||||||
((name runtest)
|
((name runtest)
|
||||||
(deps ((alias runtest_endorsement)
|
(deps ((alias runtest_michelson_parser)
|
||||||
(alias runtest_michelson_parser)
|
|
||||||
;(alias runtest_origination)
|
;(alias runtest_origination)
|
||||||
;(alias runtest_transaction)
|
;(alias runtest_transaction)
|
||||||
(alias runtest_rpc)
|
(alias runtest_rpc)
|
||||||
|
@ -547,14 +547,14 @@ module Endorse = struct
|
|||||||
let forge_endorsement
|
let forge_endorsement
|
||||||
block
|
block
|
||||||
src_sk
|
src_sk
|
||||||
slot =
|
=
|
||||||
Shell_services.Blocks.hash !rpc_ctxt ~block () >>=? fun hash ->
|
Shell_services.Blocks.hash !rpc_ctxt ~block () >>=? fun hash ->
|
||||||
Alpha_block_services.metadata
|
Alpha_block_services.metadata
|
||||||
!rpc_ctxt ~chain:`Main ~block () >>=? fun { protocol_data = { level } } ->
|
!rpc_ctxt ~chain:`Main ~block () >>=? fun { protocol_data = { level } } ->
|
||||||
let level = level.level in
|
let level = level.level in
|
||||||
let shell = { Tezos_base.Operation.branch = hash } in
|
let shell = { Tezos_base.Operation.branch = hash } in
|
||||||
let contents =
|
let contents =
|
||||||
Single (Endorsements { block = hash ; level ; slots = [ slot ]}) in
|
Single (Endorsement { block = hash ; level }) in
|
||||||
sign ~watermark:Endorsement src_sk shell (Contents_list contents)
|
sign ~watermark:Endorsement src_sk shell (Contents_list contents)
|
||||||
|
|
||||||
let signing_slots
|
let signing_slots
|
||||||
@ -568,25 +568,9 @@ module Endorse = struct
|
|||||||
| _ -> return []
|
| _ -> return []
|
||||||
|
|
||||||
let endorse
|
let endorse
|
||||||
?slot
|
|
||||||
(contract : Account.t)
|
(contract : Account.t)
|
||||||
block =
|
block =
|
||||||
Alpha_block_services.metadata
|
forge_endorsement block contract.sk
|
||||||
!rpc_ctxt ~chain:`Main ~block () >>=? fun { protocol_data = { level } } ->
|
|
||||||
let level = level.level in
|
|
||||||
begin
|
|
||||||
match slot with
|
|
||||||
| Some slot -> return slot
|
|
||||||
| None -> begin
|
|
||||||
signing_slots
|
|
||||||
block contract.Account.pkh
|
|
||||||
level >>=? function
|
|
||||||
| slot::_ -> return slot
|
|
||||||
| [] ->
|
|
||||||
failwith "No slot found at level %a" Raw_level.pp level
|
|
||||||
end
|
|
||||||
end >>=? fun slot ->
|
|
||||||
forge_endorsement block contract.sk slot
|
|
||||||
|
|
||||||
(* FIXME @vb: I don't understand this function, copied from @cago. *)
|
(* FIXME @vb: I don't understand this function, copied from @cago. *)
|
||||||
let endorsers_list block =
|
let endorsers_list block =
|
||||||
|
@ -112,7 +112,6 @@ end
|
|||||||
module Endorse : sig
|
module Endorse : sig
|
||||||
|
|
||||||
val endorse :
|
val endorse :
|
||||||
?slot:int ->
|
|
||||||
Account.t ->
|
Account.t ->
|
||||||
Block_services.block ->
|
Block_services.block ->
|
||||||
Operation.packed tzresult Lwt.t
|
Operation.packed tzresult Lwt.t
|
||||||
|
@ -1,270 +0,0 @@
|
|||||||
(**************************************************************************)
|
|
||||||
(* *)
|
|
||||||
(* Copyright (c) 2014 - 2018. *)
|
|
||||||
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
|
|
||||||
(* *)
|
|
||||||
(* All rights reserved. No warranty, explicit or implicit, provided. *)
|
|
||||||
(* *)
|
|
||||||
(**************************************************************************)
|
|
||||||
|
|
||||||
open Proto_alpha
|
|
||||||
open Alpha_context
|
|
||||||
module Helpers = Proto_alpha_helpers
|
|
||||||
module Assert = Helpers.Assert
|
|
||||||
|
|
||||||
let { Helpers.Account.b1 ; b2 ; b3 ; b4 ; b5 } =
|
|
||||||
Helpers.Account.bootstrap_accounts
|
|
||||||
|
|
||||||
let default_account =
|
|
||||||
Helpers.Account.create "default_account"
|
|
||||||
|
|
||||||
let test_double_endorsement_evidence contract block =
|
|
||||||
|
|
||||||
(* Double endorsement for the same level *)
|
|
||||||
Helpers.Baking.bake block contract [] >>=? fun b1 ->
|
|
||||||
|
|
||||||
(* branch root *)
|
|
||||||
Helpers.Baking.bake (`Hash (b1, 0)) contract [] >>=? fun b2 ->
|
|
||||||
(* changing branch *)
|
|
||||||
Helpers.Baking.bake (`Hash (b1, 0)) contract [] >>=? fun b2' ->
|
|
||||||
|
|
||||||
(* branch root *)
|
|
||||||
Helpers.Endorse.endorse contract (`Hash (b2, 0)) >>=? fun op ->
|
|
||||||
Helpers.Baking.bake (`Hash (b2, 0)) contract [ op ] >>=? fun _b3 ->
|
|
||||||
|
|
||||||
Helpers.Endorse.endorse contract (`Hash (b2', 0)) >>=? fun op ->
|
|
||||||
Helpers.Baking.bake (`Hash (b2', 0)) contract [ op ] >>=? fun b3' ->
|
|
||||||
|
|
||||||
Helpers.Endorse.endorse contract (`Hash (b3', 0)) >>=? fun op ->
|
|
||||||
Helpers.Baking.bake (`Hash (b3', 0)) contract [ op ] >>=? fun b4' ->
|
|
||||||
|
|
||||||
(* TODO: Inject double endorsement op ! *)
|
|
||||||
Helpers.Baking.bake (`Hash (b4', 0)) contract []
|
|
||||||
|
|
||||||
(* FIXME: Baking.Invalid_signature is unclassified *)
|
|
||||||
let test_invalid_signature block =
|
|
||||||
let public_key =
|
|
||||||
Signature.Public_key.of_b58check_exn
|
|
||||||
"edpkv8EUUH68jmo3f7Um5PezmfGrRF24gnfLpH3sVNwJnV5bVCxL2n" in
|
|
||||||
let secret_key =
|
|
||||||
Signature.Secret_key.of_b58check_exn
|
|
||||||
"edsk3gUfUPyBSfrS9CCgmCiQsTCHGkviBDusMxDJstFtojtc1zcpsh" in
|
|
||||||
let account =
|
|
||||||
Helpers.Account.create ~keys:(secret_key, public_key) "WRONG SIGNATURE" in
|
|
||||||
Helpers.Baking.bake block account [] >>= fun res ->
|
|
||||||
Assert.generic_economic_error ~msg:__LOC__ res ;
|
|
||||||
return ()
|
|
||||||
|
|
||||||
let contain_tzerror ?(msg="") ~f t =
|
|
||||||
t >>= function
|
|
||||||
| Ok _ -> failwith "%s: Expected error found success" msg
|
|
||||||
| Error error when not (List.exists f error) ->
|
|
||||||
failwith "@[<v 2>Unexpected error@ %a@]" pp_print_error error
|
|
||||||
| _ -> return ()
|
|
||||||
|
|
||||||
let test_wrong_delegate ~baker contract block =
|
|
||||||
begin
|
|
||||||
Helpers.Endorse.endorse ~slot:1 contract block >>=? fun op ->
|
|
||||||
Helpers.Baking.bake block baker [ op ] >>=? fun _ ->
|
|
||||||
Helpers.Endorse.endorse ~slot:2 contract block >>=? fun op ->
|
|
||||||
Helpers.Baking.bake block baker [ op ] >>=? fun _ ->
|
|
||||||
Helpers.Endorse.endorse ~slot:3 contract block >>=? fun op ->
|
|
||||||
Helpers.Baking.bake block baker [ op ] >>=? fun _ ->
|
|
||||||
Helpers.Endorse.endorse ~slot:4 contract block >>=? fun op ->
|
|
||||||
Helpers.Baking.bake block baker [ op ] >>=? fun _ ->
|
|
||||||
Helpers.Endorse.endorse ~slot:5 contract block >>=? fun op ->
|
|
||||||
Helpers.Baking.bake block baker [ op ] >>=? fun _ ->
|
|
||||||
return ()
|
|
||||||
end >>= fun res ->
|
|
||||||
Assert.failed_to_preapply ~msg:__LOC__ begin function
|
|
||||||
| Alpha_context.Operation.Invalid_signature -> true
|
|
||||||
| _ -> false
|
|
||||||
end res ;
|
|
||||||
Lwt.return_unit
|
|
||||||
|
|
||||||
let test_invalid_endorsement_slot contract block =
|
|
||||||
Helpers.Endorse.endorse ~slot:~-1 contract block >>=? fun op ->
|
|
||||||
Helpers.Baking.bake block contract [ op ] >>= fun res ->
|
|
||||||
Assert.failed_to_preapply ~msg:__LOC__ ~op begin function
|
|
||||||
| Baking.Invalid_endorsement_slot _ -> true
|
|
||||||
| _ -> false
|
|
||||||
end res ;
|
|
||||||
Helpers.Endorse.endorse ~slot:16 contract block >>=? fun op ->
|
|
||||||
Helpers.Baking.bake block contract [ op ] >>= fun res ->
|
|
||||||
Assert.failed_to_preapply ~msg:__LOC__ ~op begin function
|
|
||||||
| Operation.Invalid_signature -> true
|
|
||||||
| _ -> false
|
|
||||||
end res ;
|
|
||||||
return ()
|
|
||||||
|
|
||||||
let test_endorsement_rewards block0 =
|
|
||||||
|
|
||||||
let get_endorser_except bs accounts =
|
|
||||||
let account, cpt = ref accounts.(0), ref 0 in
|
|
||||||
while List.mem !account bs do
|
|
||||||
incr cpt ;
|
|
||||||
account := accounts.(!cpt)
|
|
||||||
done ;
|
|
||||||
return (!account, !cpt) in
|
|
||||||
|
|
||||||
Proto_alpha_helpers.endorsement_security_deposit block0 >>=? fun deposit ->
|
|
||||||
let deposit = Tez.to_mutez deposit in
|
|
||||||
|
|
||||||
(* Endorsement Rights *)
|
|
||||||
(* #1 endorse & inject in a block *)
|
|
||||||
Helpers.Endorse.endorsers_list block0 >>=? fun accounts ->
|
|
||||||
get_endorser_except [ b1 ] accounts >>=? fun (account0, slot0) ->
|
|
||||||
Helpers.Account.balance ~block:block0 account0 >>=? fun balance0 ->
|
|
||||||
Helpers.Endorse.endorse ~slot:slot0 account0 block0 >>=? fun op ->
|
|
||||||
Helpers.Baking.bake block0 b1 [ op ] >>=? fun hash1 ->
|
|
||||||
Helpers.display_level (`Hash (hash1, 0)) >>=? fun () ->
|
|
||||||
Assert.balance_equal ~block:(`Hash (hash1, 0)) ~msg:__LOC__ account0
|
|
||||||
(Int64.sub (Tez.to_mutez balance0) deposit) >>=? fun () ->
|
|
||||||
|
|
||||||
(* #2 endorse & inject in a block *)
|
|
||||||
let block1 = `Hash (hash1, 0) in
|
|
||||||
Helpers.Endorse.endorsers_list block1 >>=? fun accounts ->
|
|
||||||
get_endorser_except [ b1 ; account0 ] accounts >>=? fun (account1, slot1) ->
|
|
||||||
Helpers.Account.balance ~block:block1 account1 >>=? fun balance1 ->
|
|
||||||
Helpers.Endorse.endorse ~slot:slot1 account1 block1 >>=? fun op ->
|
|
||||||
Helpers.Baking.bake block1 b1 [ op ] >>=? fun hash2 ->
|
|
||||||
Helpers.display_level (`Hash (hash2, 0)) >>=? fun () ->
|
|
||||||
Assert.balance_equal ~block:(`Hash (hash2, 0)) ~msg:__LOC__ account1
|
|
||||||
(Int64.sub (Tez.to_mutez balance1) deposit) >>=? fun () ->
|
|
||||||
|
|
||||||
(*
|
|
||||||
(* Check rewards after one cycle for account0 *)
|
|
||||||
Helpers.Baking.bake (`Hash (hash2, 0)) b1 [] >>=? fun hash3 ->
|
|
||||||
Helpers.display_level (`Hash (hash3, 0)) >>=? fun () ->
|
|
||||||
Helpers.Baking.bake (`Hash (hash3, 0)) b1 [] >>=? fun hash4 ->
|
|
||||||
Helpers.display_level (`Hash (hash4, 0)) >>=? fun () ->
|
|
||||||
Helpers.Baking.bake (`Hash (hash4, 0)) b1 [] >>=? fun hash5 ->
|
|
||||||
Helpers.display_level (`Hash (hash5, 0)) >>=? fun () ->
|
|
||||||
Helpers.Baking.endorsement_reward block1 >>=? fun rw0 ->
|
|
||||||
Assert.balance_equal ~block:(`Hash (hash5, 0)) ~msg:__LOC__ account0
|
|
||||||
(Int64.add (Tez.to_mutez balance0) rw0) >>=? fun () ->
|
|
||||||
|
|
||||||
(* Check rewards after one cycle for account1 *)
|
|
||||||
Helpers.Baking.endorsement_reward (`Hash (hash2, 0)) >>=? fun rw1 ->
|
|
||||||
Assert.balance_equal ~block:(`Hash (hash5, 0)) ~msg:__LOC__ account1
|
|
||||||
(Int64.add (Tez.to_mutez balance1) rw1) >>=? fun () ->
|
|
||||||
|
|
||||||
(* #2 endorse and check reward only on the good chain *)
|
|
||||||
Helpers.Baking.bake (`Hash (hash5, 0)) b1 []>>=? fun hash6a ->
|
|
||||||
Helpers.display_level (`Hash (hash6a, 0)) >>=? fun () ->
|
|
||||||
Helpers.Baking.bake (`Hash (hash5, 0)) b1 [] >>=? fun hash6b ->
|
|
||||||
Helpers.display_level (`Hash (hash6b, 0)) >>=? fun () ->
|
|
||||||
|
|
||||||
(* working on head *)
|
|
||||||
Helpers.Endorse.endorsers_list (`Hash (hash6a, 0)) >>=? fun accounts ->
|
|
||||||
get_endorser_except [ b1 ] accounts >>=? fun (account3, slot3) ->
|
|
||||||
Helpers.Account.balance ~block:(`Hash (hash6a, 0)) account3 >>=? fun balance3 ->
|
|
||||||
Helpers.Endorse.endorse
|
|
||||||
~slot:slot3 account3 (`Hash (hash6a, 0)) >>=? fun ops ->
|
|
||||||
Helpers.Baking.bake (`Hash (hash6a, 0)) b1 [ ops ] >>=? fun hash7a ->
|
|
||||||
Helpers.display_level (`Hash (hash7a, 0)) >>=? fun () ->
|
|
||||||
|
|
||||||
(* working on fork *)
|
|
||||||
Helpers.Endorse.endorsers_list (`Hash (hash6b, 0)) >>=? fun accounts ->
|
|
||||||
get_endorser_except [ b1 ] accounts >>=? fun (account4, slot4) ->
|
|
||||||
Helpers.Account.balance ~block:(`Hash (hash7a, 0)) account4 >>=? fun _balance4 ->
|
|
||||||
Helpers.Endorse.endorse ~slot:slot4 account4 (`Hash (hash6b, 0)) >>=? fun ops ->
|
|
||||||
Helpers.Baking.bake (`Hash (hash6b, 0)) b1 [ ops ] >>=? fun _new_fork ->
|
|
||||||
Helpers.display_level (`Hash (_new_fork, 0)) >>=? fun () ->
|
|
||||||
Helpers.Account.balance ~block:(`Hash (hash7a, 0)) account4 >>=? fun balance4 ->
|
|
||||||
|
|
||||||
Helpers.Baking.bake (`Hash (hash7a, 0)) b1 [] >>=? fun hash8a ->
|
|
||||||
Helpers.display_level (`Hash (hash8a, 0)) >>=? fun () ->
|
|
||||||
Helpers.Baking.bake (`Hash (hash8a, 0)) b1 [] >>=? fun hash9a ->
|
|
||||||
Helpers.display_level (`Hash (hash9a, 0)) >>=? fun () ->
|
|
||||||
|
|
||||||
(* Check rewards after one cycle *)
|
|
||||||
Helpers.Baking.endorsement_reward (`Hash (hash7a, 0)) >>=? fun reward ->
|
|
||||||
Assert.balance_equal ~block:(`Hash (hash9a, 0)) ~msg:__LOC__ account3
|
|
||||||
(Int64.add (Tez.to_mutez balance3) reward) >>=? fun () ->
|
|
||||||
|
|
||||||
(* Check no reward for the fork *)
|
|
||||||
begin
|
|
||||||
if account3 = account4 then return ()
|
|
||||||
(* if account4 is different from account3, we need to check that there
|
|
||||||
is no reward for him since the endorsement was in the fork branch *)
|
|
||||||
else Assert.balance_equal ~block:(`Hash (hash9a, 0)) ~msg:__LOC__ account4 (Tez.to_mutez balance4)
|
|
||||||
end >>=? fun () ->
|
|
||||||
|
|
||||||
*)
|
|
||||||
return ()
|
|
||||||
|
|
||||||
let test_endorsement_rights contract block =
|
|
||||||
Helpers.Endorse.endorsement_rights contract block >>|? fun possibilities ->
|
|
||||||
possibilities <> []
|
|
||||||
|
|
||||||
let run genesis =
|
|
||||||
|
|
||||||
Helpers.Baking.bake genesis b2 [] >>=? fun blk ->
|
|
||||||
|
|
||||||
let block = `Hash (blk, 0) in
|
|
||||||
test_endorsement_rights
|
|
||||||
default_account block >>=? fun has_right_to_endorse ->
|
|
||||||
Assert.equal_bool ~msg:__LOC__ has_right_to_endorse false ;
|
|
||||||
test_endorsement_rights b1 block >>=? fun has_right_to_endorse ->
|
|
||||||
Assert.equal_bool ~msg:__LOC__ has_right_to_endorse true ;
|
|
||||||
test_endorsement_rights b1 block >>=? fun has_right_to_endorse ->
|
|
||||||
Assert.equal_bool ~msg:__LOC__ has_right_to_endorse true ;
|
|
||||||
|
|
||||||
Assert.balance_equal
|
|
||||||
~block:block ~msg:__LOC__ b1 4_000_000_000_000L >>=? fun () ->
|
|
||||||
Assert.balance_equal
|
|
||||||
~block:block ~msg:__LOC__ b2 3_999_488_000_000L >>=? fun () ->
|
|
||||||
Assert.balance_equal
|
|
||||||
~block:block ~msg:__LOC__ b3 4_000_000_000_000L >>=? fun () ->
|
|
||||||
Assert.balance_equal
|
|
||||||
~block:block ~msg:__LOC__ b4 4_000_000_000_000L >>=? fun () ->
|
|
||||||
Assert.balance_equal
|
|
||||||
~block:block ~msg:__LOC__ b5 4_000_000_000_000L >>=? fun () ->
|
|
||||||
|
|
||||||
(* Check Rewards *)
|
|
||||||
test_endorsement_rewards block >>=? fun () ->
|
|
||||||
|
|
||||||
(* Endorse with a contract with wrong delegate:
|
|
||||||
- contract with no endorsement rights
|
|
||||||
- contract which signs at every available slots *)
|
|
||||||
test_wrong_delegate ~baker:b1 default_account block >>= fun () ->
|
|
||||||
test_wrong_delegate ~baker:b1 b5 block >>= fun () ->
|
|
||||||
|
|
||||||
(* Endorse with a wrong slot : -1 and max (16) *)
|
|
||||||
test_invalid_endorsement_slot b3 block >>=? fun () ->
|
|
||||||
|
|
||||||
(* FIXME: Baking.Invalid_signature is still unclassified *)
|
|
||||||
test_invalid_signature block >>=? fun _ ->
|
|
||||||
|
|
||||||
(* FIXME: cannot inject double endorsement operation yet, but the
|
|
||||||
code is still here
|
|
||||||
Double endorsement *)
|
|
||||||
test_double_endorsement_evidence b4 block >>=? fun _ ->
|
|
||||||
|
|
||||||
return ()
|
|
||||||
|
|
||||||
let exe = try Sys.argv.(1) with _ -> "tezos-node"
|
|
||||||
let rpc_port = try int_of_string Sys.argv.(2) with _ -> 18100
|
|
||||||
|
|
||||||
let main () =
|
|
||||||
Helpers.init ~exe ~rpc_port () >>=? fun (_node_pid, genesis) ->
|
|
||||||
run (`Hash (genesis, 0))
|
|
||||||
|
|
||||||
|
|
||||||
let tests = [
|
|
||||||
"main", (fun _ -> main ()) ;
|
|
||||||
]
|
|
||||||
|
|
||||||
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 () =
|
|
||||||
Alcotest.run ~argv:[|""|] "tezos-client-alpha" [
|
|
||||||
"endorsement", List.map wrap tests
|
|
||||||
]
|
|
@ -137,8 +137,9 @@ let finalize ?commit_message:message c =
|
|||||||
let activate = Raw_context.activate
|
let activate = Raw_context.activate
|
||||||
let fork_test_chain = Raw_context.fork_test_chain
|
let fork_test_chain = Raw_context.fork_test_chain
|
||||||
|
|
||||||
let endorsement_already_recorded = Raw_context.endorsement_already_recorded
|
|
||||||
let record_endorsement = Raw_context.record_endorsement
|
let record_endorsement = Raw_context.record_endorsement
|
||||||
|
let allowed_endorsements = Raw_context.allowed_endorsements
|
||||||
|
let init_endorsements = Raw_context.init_endorsements
|
||||||
|
|
||||||
let reset_internal_nonce = Raw_context.reset_internal_nonce
|
let reset_internal_nonce = Raw_context.reset_internal_nonce
|
||||||
let fresh_internal_nonce = Raw_context.fresh_internal_nonce
|
let fresh_internal_nonce = Raw_context.fresh_internal_nonce
|
||||||
|
@ -772,7 +772,7 @@ module Kind : sig
|
|||||||
type double_endorsement_evidence = Double_endorsement_evidence_kind
|
type double_endorsement_evidence = Double_endorsement_evidence_kind
|
||||||
type double_baking_evidence = Double_baking_evidence_kind
|
type double_baking_evidence = Double_baking_evidence_kind
|
||||||
type activate_account = Activate_account_kind
|
type activate_account = Activate_account_kind
|
||||||
type endorsements = Endorsements_kind
|
type endorsement = Endorsement_kind
|
||||||
type proposals = Proposals_kind
|
type proposals = Proposals_kind
|
||||||
type ballot = Ballot_kind
|
type ballot = Ballot_kind
|
||||||
type reveal = Reveal_kind
|
type reveal = Reveal_kind
|
||||||
@ -802,18 +802,17 @@ and _ contents_list =
|
|||||||
(('kind * 'rest) Kind.manager ) contents_list
|
(('kind * 'rest) Kind.manager ) contents_list
|
||||||
|
|
||||||
and _ contents =
|
and _ contents =
|
||||||
| Endorsements : {
|
| Endorsement : {
|
||||||
block: Block_hash.t ;
|
block: Block_hash.t ;
|
||||||
level: Raw_level.t ;
|
level: Raw_level.t ;
|
||||||
slots: int list ;
|
} -> Kind.endorsement contents
|
||||||
} -> Kind.endorsements contents
|
|
||||||
| Seed_nonce_revelation : {
|
| Seed_nonce_revelation : {
|
||||||
level: Raw_level.t ;
|
level: Raw_level.t ;
|
||||||
nonce: Nonce.t ;
|
nonce: Nonce.t ;
|
||||||
} -> Kind.seed_nonce_revelation contents
|
} -> Kind.seed_nonce_revelation contents
|
||||||
| Double_endorsement_evidence : {
|
| Double_endorsement_evidence : {
|
||||||
op1: Kind.endorsements operation ;
|
op1: Kind.endorsement operation ;
|
||||||
op2: Kind.endorsements operation ;
|
op2: Kind.endorsement operation ;
|
||||||
} -> Kind.double_endorsement_evidence contents
|
} -> Kind.double_endorsement_evidence contents
|
||||||
| Double_baking_evidence : {
|
| Double_baking_evidence : {
|
||||||
bh1: Block_header.t ;
|
bh1: Block_header.t ;
|
||||||
@ -929,6 +928,7 @@ module Operation : sig
|
|||||||
type error += Invalid_signature (* `Permanent *)
|
type error += Invalid_signature (* `Permanent *)
|
||||||
|
|
||||||
val check_signature: public_key -> _ operation -> unit tzresult Lwt.t
|
val check_signature: public_key -> _ operation -> unit tzresult Lwt.t
|
||||||
|
val raw_check_signature: public_key -> _ operation -> unit tzresult
|
||||||
|
|
||||||
val internal_operation_encoding: packed_internal_operation Data_encoding.t
|
val internal_operation_encoding: packed_internal_operation Data_encoding.t
|
||||||
|
|
||||||
@ -947,7 +947,7 @@ module Operation : sig
|
|||||||
proj: 'b contents -> 'a ;
|
proj: 'b contents -> 'a ;
|
||||||
inj: 'a -> 'b contents } -> 'b case
|
inj: 'a -> 'b contents } -> 'b case
|
||||||
|
|
||||||
val endorsement_case: Kind.endorsements case
|
val endorsement_case: Kind.endorsement case
|
||||||
val seed_nonce_revelation_case: Kind.seed_nonce_revelation case
|
val seed_nonce_revelation_case: Kind.seed_nonce_revelation case
|
||||||
val double_endorsement_evidence_case: Kind.double_endorsement_evidence case
|
val double_endorsement_evidence_case: Kind.double_endorsement_evidence case
|
||||||
val double_baking_evidence_case: Kind.double_baking_evidence case
|
val double_baking_evidence_case: Kind.double_baking_evidence case
|
||||||
@ -1055,8 +1055,15 @@ val finalize: ?commit_message:string -> context -> Updater.validation_result
|
|||||||
val activate: context -> Protocol_hash.t -> context Lwt.t
|
val activate: context -> Protocol_hash.t -> context Lwt.t
|
||||||
val fork_test_chain: context -> Protocol_hash.t -> Time.t -> context Lwt.t
|
val fork_test_chain: context -> Protocol_hash.t -> Time.t -> context Lwt.t
|
||||||
|
|
||||||
val endorsement_already_recorded: context -> int -> bool
|
val record_endorsement:
|
||||||
val record_endorsement: context -> int -> context
|
context -> Signature.Public_key_hash.t -> context
|
||||||
|
val allowed_endorsements:
|
||||||
|
context ->
|
||||||
|
(Signature.Public_key.t * int list) Signature.Public_key_hash.Map.t
|
||||||
|
val init_endorsements:
|
||||||
|
context ->
|
||||||
|
(Signature.Public_key.t * int list) Signature.Public_key_hash.Map.t ->
|
||||||
|
context
|
||||||
|
|
||||||
val reset_internal_nonce: context -> context
|
val reset_internal_nonce: context -> context
|
||||||
val fresh_internal_nonce: context -> (context * int) tzresult
|
val fresh_internal_nonce: context -> (context * int) tzresult
|
||||||
|
@ -13,7 +13,6 @@ open Alpha_context
|
|||||||
|
|
||||||
type error += Wrong_voting_period of Voting_period.t * Voting_period.t (* `Temporary *)
|
type error += Wrong_voting_period of Voting_period.t * Voting_period.t (* `Temporary *)
|
||||||
type error += Wrong_endorsement_predecessor of Block_hash.t * Block_hash.t (* `Temporary *)
|
type error += Wrong_endorsement_predecessor of Block_hash.t * Block_hash.t (* `Temporary *)
|
||||||
type error += Duplicate_endorsement of int (* `Branch *)
|
|
||||||
type error += Invalid_endorsement_level
|
type error += Invalid_endorsement_level
|
||||||
type error += Invalid_commitment of { expected: bool }
|
type error += Invalid_commitment of { expected: bool }
|
||||||
type error += Internal_operation_replay of packed_internal_operation
|
type error += Internal_operation_replay of packed_internal_operation
|
||||||
@ -71,16 +70,6 @@ let () =
|
|||||||
(req "provided" Voting_period.encoding))
|
(req "provided" Voting_period.encoding))
|
||||||
(function Wrong_voting_period (e, p) -> Some (e, p) | _ -> None)
|
(function Wrong_voting_period (e, p) -> Some (e, p) | _ -> None)
|
||||||
(fun (e, p) -> Wrong_voting_period (e, p));
|
(fun (e, p) -> Wrong_voting_period (e, p));
|
||||||
register_error_kind
|
|
||||||
`Branch
|
|
||||||
~id:"operation.duplicate_endorsement"
|
|
||||||
~title:"Duplicate endorsement"
|
|
||||||
~description:"Two endorsements received for the same slot"
|
|
||||||
~pp:(fun ppf k ->
|
|
||||||
Format.fprintf ppf "Duplicate endorsement for slot %d." k)
|
|
||||||
Data_encoding.(obj1 (req "slot" uint16))
|
|
||||||
(function Duplicate_endorsement k -> Some k | _ -> None)
|
|
||||||
(fun k -> Duplicate_endorsement k);
|
|
||||||
register_error_kind
|
register_error_kind
|
||||||
`Temporary
|
`Temporary
|
||||||
~id:"operation.invalid_endorsement_level"
|
~id:"operation.invalid_endorsement_level"
|
||||||
@ -602,30 +591,21 @@ let rec apply_manager_contents_list
|
|||||||
Lwt.return (ctxt, Cons_result (result, mark_skipped rest))
|
Lwt.return (ctxt, Cons_result (result, mark_skipped rest))
|
||||||
|
|
||||||
let apply_contents_list
|
let apply_contents_list
|
||||||
(type kind) ctxt mode pred_block operation (contents_list : kind contents_list)
|
(type kind) ctxt mode pred_block
|
||||||
|
(operation : kind operation)
|
||||||
|
(contents_list : kind contents_list)
|
||||||
: (context * kind contents_result_list) tzresult Lwt.t =
|
: (context * kind contents_result_list) tzresult Lwt.t =
|
||||||
match contents_list with
|
match contents_list with
|
||||||
| Single (Endorsements { block ; level ; slots }) ->
|
| Single (Endorsement { block ; level }) ->
|
||||||
begin
|
let current_level = (Level.current ctxt).level in
|
||||||
match Level.pred ctxt (Level.current ctxt) with
|
|
||||||
| None -> assert false (* absurd: (Level.current ctxt).raw_level > 0 *)
|
|
||||||
| Some lvl -> return lvl
|
|
||||||
end >>=? fun ({ level = current_level ;_ } as lvl) ->
|
|
||||||
fail_unless
|
fail_unless
|
||||||
(Block_hash.equal block pred_block)
|
(Block_hash.equal block pred_block)
|
||||||
(Wrong_endorsement_predecessor (pred_block, block)) >>=? fun () ->
|
(Wrong_endorsement_predecessor (pred_block, block)) >>=? fun () ->
|
||||||
fail_unless
|
fail_unless
|
||||||
Raw_level.(level = current_level)
|
Raw_level.(succ level = current_level)
|
||||||
Invalid_endorsement_level >>=? fun () ->
|
Invalid_endorsement_level >>=? fun () ->
|
||||||
fold_left_s (fun ctxt slot ->
|
Baking.check_endorsement_rights ctxt operation >>=? fun (delegate, slots) ->
|
||||||
fail_when
|
let ctxt = record_endorsement ctxt delegate in
|
||||||
(endorsement_already_recorded ctxt slot)
|
|
||||||
(Duplicate_endorsement slot) >>=? fun () ->
|
|
||||||
return (record_endorsement ctxt slot))
|
|
||||||
ctxt slots >>=? fun ctxt ->
|
|
||||||
Baking.check_endorsements_rights ctxt lvl slots >>=? fun delegate ->
|
|
||||||
Operation.check_signature delegate operation >>=? fun () ->
|
|
||||||
let delegate = Signature.Public_key.hash delegate in
|
|
||||||
let gap = List.length slots in
|
let gap = List.length slots in
|
||||||
let ctxt = Fitness.increase ~gap ctxt in
|
let ctxt = Fitness.increase ~gap ctxt in
|
||||||
Lwt.return
|
Lwt.return
|
||||||
@ -635,7 +615,7 @@ let apply_contents_list
|
|||||||
Global.get_last_block_priority ctxt >>=? fun block_priority ->
|
Global.get_last_block_priority ctxt >>=? fun block_priority ->
|
||||||
Baking.endorsement_reward ctxt ~block_priority gap >>=? fun reward ->
|
Baking.endorsement_reward ctxt ~block_priority gap >>=? fun reward ->
|
||||||
Delegate.freeze_rewards ctxt delegate reward >>=? fun ctxt ->
|
Delegate.freeze_rewards ctxt delegate reward >>=? fun ctxt ->
|
||||||
return (ctxt, Single_result (Endorsements_result (delegate, slots)))
|
return (ctxt, Single_result (Endorsement_result (delegate, slots)))
|
||||||
| Single (Seed_nonce_revelation { level ; nonce }) ->
|
| Single (Seed_nonce_revelation { level ; nonce }) ->
|
||||||
let level = Level.from_raw ctxt level in
|
let level = Level.from_raw ctxt level in
|
||||||
Nonce.reveal ctxt level nonce >>=? fun ctxt ->
|
Nonce.reveal ctxt level nonce >>=? fun ctxt ->
|
||||||
@ -645,8 +625,8 @@ let apply_contents_list
|
|||||||
return (ctxt, Single_result (Seed_nonce_revelation_result [(* FIXME *)]))
|
return (ctxt, Single_result (Seed_nonce_revelation_result [(* FIXME *)]))
|
||||||
| Single (Double_endorsement_evidence { op1 ; op2 }) -> begin
|
| Single (Double_endorsement_evidence { op1 ; op2 }) -> begin
|
||||||
match op1.protocol_data.contents, op2.protocol_data.contents with
|
match op1.protocol_data.contents, op2.protocol_data.contents with
|
||||||
| Single (Endorsements e1),
|
| Single (Endorsement e1),
|
||||||
Single (Endorsements e2)
|
Single (Endorsement e2)
|
||||||
when Raw_level.(e1.level = e2.level) &&
|
when Raw_level.(e1.level = e2.level) &&
|
||||||
not (Block_hash.equal e1.block e2.block) ->
|
not (Block_hash.equal e1.block e2.block) ->
|
||||||
let level = Level.from_raw ctxt e1.level in
|
let level = Level.from_raw ctxt e1.level in
|
||||||
@ -659,23 +639,15 @@ let apply_contents_list
|
|||||||
(Outdated_double_endorsement_evidence
|
(Outdated_double_endorsement_evidence
|
||||||
{ level = level.level ;
|
{ level = level.level ;
|
||||||
last = oldest_level }) >>=? fun () ->
|
last = oldest_level }) >>=? fun () ->
|
||||||
(* Whenever a delegate might have multiple endorsement slots for
|
Baking.check_endorsement_rights ctxt op1 >>=? fun (delegate1, _) ->
|
||||||
given level, she should not endorse different block with different
|
Baking.check_endorsement_rights ctxt op2 >>=? fun (delegate2, _) ->
|
||||||
slots. Hence, we don't check that [e1.slots] and [e2.slots]
|
|
||||||
intersect. *)
|
|
||||||
Baking.check_endorsements_rights ctxt level e1.slots >>=? fun delegate1 ->
|
|
||||||
Operation.check_signature delegate1 op1 >>=? fun () ->
|
|
||||||
Baking.check_endorsements_rights ctxt level e2.slots >>=? fun delegate2 ->
|
|
||||||
Operation.check_signature delegate2 op2 >>=? fun () ->
|
|
||||||
fail_unless
|
fail_unless
|
||||||
(Signature.Public_key.equal delegate1 delegate2)
|
(Signature.Public_key_hash.equal delegate1 delegate2)
|
||||||
(Inconsistent_double_endorsement_evidence
|
(Inconsistent_double_endorsement_evidence
|
||||||
{ delegate1 = Signature.Public_key.hash delegate1 ;
|
{ delegate1 ; delegate2 }) >>=? fun () ->
|
||||||
delegate2 = Signature.Public_key.hash delegate2 }) >>=? fun () ->
|
Delegate.has_frozen_balance ctxt delegate1 level.cycle >>=? fun valid ->
|
||||||
let delegate = Signature.Public_key.hash delegate1 in
|
|
||||||
Delegate.has_frozen_balance ctxt delegate level.cycle >>=? fun valid ->
|
|
||||||
fail_unless valid Unrequired_double_endorsement_evidence >>=? fun () ->
|
fail_unless valid Unrequired_double_endorsement_evidence >>=? fun () ->
|
||||||
Delegate.punish ctxt delegate level.cycle >>=? fun (ctxt, burned) ->
|
Delegate.punish ctxt delegate1 level.cycle >>=? fun (ctxt, burned) ->
|
||||||
let reward =
|
let reward =
|
||||||
match Tez.(burned /? 2L) with
|
match Tez.(burned /? 2L) with
|
||||||
| Ok v -> v
|
| Ok v -> v
|
||||||
@ -799,11 +771,21 @@ let begin_full_construction ctxt pred_timestamp protocol_data =
|
|||||||
Baking.check_baking_rights
|
Baking.check_baking_rights
|
||||||
ctxt protocol_data pred_timestamp >>=? fun delegate_pk ->
|
ctxt protocol_data pred_timestamp >>=? fun delegate_pk ->
|
||||||
let ctxt = Fitness.increase ctxt in
|
let ctxt = Fitness.increase ctxt in
|
||||||
return (ctxt, protocol_data, delegate_pk)
|
match Level.pred ctxt (Level.current ctxt) with
|
||||||
|
| None -> assert false (* genesis *)
|
||||||
|
| Some pred_level ->
|
||||||
|
Baking.endorsement_rights ctxt pred_level >>=? fun rights ->
|
||||||
|
let ctxt = init_endorsements ctxt rights in
|
||||||
|
return (ctxt, protocol_data, delegate_pk)
|
||||||
|
|
||||||
let begin_partial_construction ctxt =
|
let begin_partial_construction ctxt =
|
||||||
let ctxt = Fitness.increase ctxt in
|
let ctxt = Fitness.increase ctxt in
|
||||||
return ctxt
|
match Level.pred ctxt (Level.current ctxt) with
|
||||||
|
| None -> assert false (* genesis *)
|
||||||
|
| Some pred_level ->
|
||||||
|
Baking.endorsement_rights ctxt pred_level >>=? fun rights ->
|
||||||
|
let ctxt = init_endorsements ctxt rights in
|
||||||
|
return ctxt
|
||||||
|
|
||||||
let begin_application ctxt block_header pred_timestamp =
|
let begin_application ctxt block_header pred_timestamp =
|
||||||
let current_level = Alpha_context.Level.current ctxt in
|
let current_level = Alpha_context.Level.current ctxt in
|
||||||
@ -821,7 +803,12 @@ let begin_application ctxt block_header pred_timestamp =
|
|||||||
(Invalid_commitment
|
(Invalid_commitment
|
||||||
{ expected = current_level.expected_commitment }) >>=? fun () ->
|
{ expected = current_level.expected_commitment }) >>=? fun () ->
|
||||||
let ctxt = Fitness.increase ctxt in
|
let ctxt = Fitness.increase ctxt in
|
||||||
return (ctxt, delegate_pk)
|
match Level.pred ctxt (Level.current ctxt) with
|
||||||
|
| None -> assert false (* genesis *)
|
||||||
|
| Some pred_level ->
|
||||||
|
Baking.endorsement_rights ctxt pred_level >>=? fun rights ->
|
||||||
|
let ctxt = init_endorsements ctxt rights in
|
||||||
|
return (ctxt, delegate_pk)
|
||||||
|
|
||||||
let finalize_application ctxt protocol_data delegate =
|
let finalize_application ctxt protocol_data delegate =
|
||||||
let deposit = Constants.block_security_deposit ctxt in
|
let deposit = Constants.block_security_deposit ctxt in
|
||||||
|
@ -334,8 +334,8 @@ let internal_operation_result_encoding :
|
|||||||
]
|
]
|
||||||
|
|
||||||
type 'kind contents_result =
|
type 'kind contents_result =
|
||||||
| Endorsements_result :
|
| Endorsement_result :
|
||||||
Signature.Public_key_hash.t * int list -> Kind.endorsements contents_result
|
Signature.Public_key_hash.t * int list -> Kind.endorsement contents_result
|
||||||
| Seed_nonce_revelation_result :
|
| Seed_nonce_revelation_result :
|
||||||
balance_updates -> Kind.seed_nonce_revelation contents_result
|
balance_updates -> Kind.seed_nonce_revelation contents_result
|
||||||
| Double_endorsement_evidence_result :
|
| Double_endorsement_evidence_result :
|
||||||
@ -389,17 +389,17 @@ module Encoding = struct
|
|||||||
(req "slots" (list uint8))) ;
|
(req "slots" (list uint8))) ;
|
||||||
select =
|
select =
|
||||||
(function
|
(function
|
||||||
| Contents_result (Endorsements_result _ as op) -> Some op
|
| Contents_result (Endorsement_result _ as op) -> Some op
|
||||||
| _ -> None) ;
|
| _ -> None) ;
|
||||||
mselect =
|
mselect =
|
||||||
(function
|
(function
|
||||||
| Contents_and_result (Endorsements _ as op, res) -> Some (op, res)
|
| Contents_and_result (Endorsement _ as op, res) -> Some (op, res)
|
||||||
| _ -> None) ;
|
| _ -> None) ;
|
||||||
proj =
|
proj =
|
||||||
(function
|
(function
|
||||||
| Endorsements_result (d, s) -> (d, s)) ;
|
| Endorsement_result (d, s) -> (d, s)) ;
|
||||||
inj =
|
inj =
|
||||||
(fun (d, s) -> Endorsements_result (d, s))
|
(fun (d, s) -> Endorsement_result (d, s))
|
||||||
}
|
}
|
||||||
|
|
||||||
let seed_nonce_revelation_case =
|
let seed_nonce_revelation_case =
|
||||||
@ -543,7 +543,7 @@ module Encoding = struct
|
|||||||
Some (Manager_operation_result
|
Some (Manager_operation_result
|
||||||
{ op with operation_result = Failed (res_case.kind, errs) })
|
{ op with operation_result = Failed (res_case.kind, errs) })
|
||||||
| Contents_result Ballot_result -> None
|
| Contents_result Ballot_result -> None
|
||||||
| Contents_result (Endorsements_result _) -> None
|
| Contents_result (Endorsement_result _) -> None
|
||||||
| Contents_result (Seed_nonce_revelation_result _) -> None
|
| Contents_result (Seed_nonce_revelation_result _) -> None
|
||||||
| Contents_result (Double_endorsement_evidence_result _) -> None
|
| Contents_result (Double_endorsement_evidence_result _) -> None
|
||||||
| Contents_result (Double_baking_evidence_result _) -> None
|
| Contents_result (Double_baking_evidence_result _) -> None
|
||||||
@ -754,8 +754,8 @@ let kind_equal
|
|||||||
: type kind kind2. kind contents -> kind2 contents_result -> (kind, kind2) eq option =
|
: type kind kind2. kind contents -> kind2 contents_result -> (kind, kind2) eq option =
|
||||||
fun op res ->
|
fun op res ->
|
||||||
match op, res with
|
match op, res with
|
||||||
| Endorsements _, Endorsements_result _ -> Some Eq
|
| Endorsement _, Endorsement_result _ -> Some Eq
|
||||||
| Endorsements _, _ -> None
|
| Endorsement _, _ -> None
|
||||||
| Seed_nonce_revelation _, Seed_nonce_revelation_result _ -> Some Eq
|
| Seed_nonce_revelation _, Seed_nonce_revelation_result _ -> Some Eq
|
||||||
| Seed_nonce_revelation _, _ -> None
|
| Seed_nonce_revelation _, _ -> None
|
||||||
| Double_endorsement_evidence _, Double_endorsement_evidence_result _ -> Some Eq
|
| Double_endorsement_evidence _, Double_endorsement_evidence_result _ -> Some Eq
|
||||||
|
@ -53,8 +53,8 @@ and packed_contents_result_list =
|
|||||||
|
|
||||||
(** Result of applying an {!Operation.contents}. Follows the same structure. *)
|
(** Result of applying an {!Operation.contents}. Follows the same structure. *)
|
||||||
and 'kind contents_result =
|
and 'kind contents_result =
|
||||||
| Endorsements_result :
|
| Endorsement_result :
|
||||||
Signature.Public_key_hash.t * int list -> Kind.endorsements contents_result
|
Signature.Public_key_hash.t * int list -> Kind.endorsement contents_result
|
||||||
| Seed_nonce_revelation_result :
|
| Seed_nonce_revelation_result :
|
||||||
balance_updates -> Kind.seed_nonce_revelation contents_result
|
balance_updates -> Kind.seed_nonce_revelation contents_result
|
||||||
| Double_endorsement_evidence_result :
|
| Double_endorsement_evidence_result :
|
||||||
|
@ -12,10 +12,8 @@ open Alpha_context
|
|||||||
open Misc
|
open Misc
|
||||||
|
|
||||||
type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *)
|
type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *)
|
||||||
type error += Invalid_endorsement_slot of int * int (* `Permanent *)
|
|
||||||
type error += Timestamp_too_early of Timestamp.t * Timestamp.t (* `Permanent *)
|
type error += Timestamp_too_early of Timestamp.t * Timestamp.t (* `Permanent *)
|
||||||
type error += Inconsistent_endorsement of public_key_hash list (* `Permanent *)
|
type error += Unexpected_endorsement
|
||||||
type error += Empty_endorsement
|
|
||||||
type error += Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t (* `Permanent *)
|
type error += Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t (* `Permanent *)
|
||||||
type error += Invalid_signature (* `Permanent *)
|
type error += Invalid_signature (* `Permanent *)
|
||||||
type error += Invalid_stamp (* `Permanent *)
|
type error += Invalid_stamp (* `Permanent *)
|
||||||
@ -48,32 +46,6 @@ let () =
|
|||||||
(req "provided" int64))
|
(req "provided" int64))
|
||||||
(function Invalid_fitness_gap (m, g) -> Some (m, g) | _ -> None)
|
(function Invalid_fitness_gap (m, g) -> Some (m, g) | _ -> None)
|
||||||
(fun (m, g) -> Invalid_fitness_gap (m, g)) ;
|
(fun (m, g) -> Invalid_fitness_gap (m, g)) ;
|
||||||
register_error_kind
|
|
||||||
`Permanent
|
|
||||||
~id:"baking.invalid_slot"
|
|
||||||
~title:"Invalid slot"
|
|
||||||
~description:"The baking slot is out of bounds"
|
|
||||||
~pp:(fun ppf (m, g) ->
|
|
||||||
Format.fprintf ppf
|
|
||||||
"The baking slot %d is not between 0 and %d" g m)
|
|
||||||
Data_encoding.(obj2
|
|
||||||
(req "maximum" int16)
|
|
||||||
(req "provided" int16))
|
|
||||||
(function Invalid_endorsement_slot (m, g) -> Some (m, g) | _ -> None)
|
|
||||||
(fun (m, g) -> Invalid_endorsement_slot (m, g)) ;
|
|
||||||
register_error_kind
|
|
||||||
`Permanent
|
|
||||||
~id:"baking.inconsisten_endorsement"
|
|
||||||
~title:"Multiple delegates for a single endorsement"
|
|
||||||
~description:"The operation tries to endorse slots with distinct delegates"
|
|
||||||
~pp:(fun ppf l ->
|
|
||||||
Format.fprintf ppf
|
|
||||||
"@[<v 2>The endorsement is inconsistent. Delegates:@ %a@]"
|
|
||||||
(Format.pp_print_list Signature.Public_key_hash.pp) l)
|
|
||||||
Data_encoding.(obj1
|
|
||||||
(req "delegates" (list Signature.Public_key_hash.encoding)))
|
|
||||||
(function Inconsistent_endorsement l -> Some l | _ -> None)
|
|
||||||
(fun l -> Inconsistent_endorsement l) ;
|
|
||||||
register_error_kind
|
register_error_kind
|
||||||
`Permanent
|
`Permanent
|
||||||
~id:"baking.invalid_block_signature"
|
~id:"baking.invalid_block_signature"
|
||||||
@ -108,8 +80,18 @@ let () =
|
|||||||
Format.fprintf ppf "Insufficient proof-of-work stamp")
|
Format.fprintf ppf "Insufficient proof-of-work stamp")
|
||||||
Data_encoding.empty
|
Data_encoding.empty
|
||||||
(function Invalid_stamp -> Some () | _ -> None)
|
(function Invalid_stamp -> Some () | _ -> None)
|
||||||
(fun () -> Invalid_stamp)
|
(fun () -> Invalid_stamp) ;
|
||||||
|
register_error_kind
|
||||||
|
`Permanent
|
||||||
|
~id:"baking.unexpected_endorsement"
|
||||||
|
~title:"Endorsement from unexpected delegate"
|
||||||
|
~description:"The operation is signed by a delegate without endorsement rights."
|
||||||
|
~pp:(fun ppf () ->
|
||||||
|
Format.fprintf ppf
|
||||||
|
"The endorsement is signed by a delegate without endorsement rights.")
|
||||||
|
Data_encoding.unit
|
||||||
|
(function Unexpected_endorsement -> Some () | _ -> None)
|
||||||
|
(fun () -> Unexpected_endorsement)
|
||||||
|
|
||||||
let minimal_time c priority pred_timestamp =
|
let minimal_time c priority pred_timestamp =
|
||||||
let priority = Int32.of_int priority in
|
let priority = Int32.of_int priority in
|
||||||
@ -154,19 +136,6 @@ let check_baking_rights c { Block_header.priority ; _ }
|
|||||||
check_timestamp c priority pred_timestamp >>=? fun () ->
|
check_timestamp c priority pred_timestamp >>=? fun () ->
|
||||||
return delegate
|
return delegate
|
||||||
|
|
||||||
let check_endorsements_rights c level slots =
|
|
||||||
map_p (fun slot ->
|
|
||||||
fail_unless Compare.Int.(0 <= slot && slot <= Constants.endorsers_per_block c)
|
|
||||||
(Invalid_endorsement_slot (Constants.endorsers_per_block c, slot)) >>=? fun () ->
|
|
||||||
Roll.endorsement_rights_owner c level ~slot)
|
|
||||||
slots >>=? function
|
|
||||||
| [] -> fail Empty_endorsement
|
|
||||||
| delegate :: delegates as all_delegates ->
|
|
||||||
fail_unless
|
|
||||||
(List.for_all (fun d -> Signature.Public_key.equal d delegate) delegates)
|
|
||||||
(Inconsistent_endorsement (List.map Signature.Public_key.hash all_delegates)) >>=? fun () ->
|
|
||||||
return delegate
|
|
||||||
|
|
||||||
type error += Incorrect_priority
|
type error += Incorrect_priority
|
||||||
|
|
||||||
let endorsement_reward ctxt ~block_priority:prio n =
|
let endorsement_reward ctxt ~block_priority:prio n =
|
||||||
@ -184,12 +153,41 @@ let baking_priorities c level =
|
|||||||
in
|
in
|
||||||
f 0
|
f 0
|
||||||
|
|
||||||
let endorsement_priorities c level =
|
let endorsement_rights c level =
|
||||||
let rec f slot =
|
fold_left_s
|
||||||
Roll.endorsement_rights_owner c level ~slot >>=? fun delegate ->
|
(fun acc slot ->
|
||||||
return (LCons (delegate, (fun () -> f (succ slot))))
|
Roll.endorsement_rights_owner c level ~slot >>=? fun pk ->
|
||||||
in
|
let pkh = Signature.Public_key.hash pk in
|
||||||
f 0
|
let slots =
|
||||||
|
match Signature.Public_key_hash.Map.find_opt pkh acc with
|
||||||
|
| None -> (pk, [slot])
|
||||||
|
| Some (pk, slots) -> (pk, slot :: slots) in
|
||||||
|
return (Signature.Public_key_hash.Map.add pkh slots acc))
|
||||||
|
Signature.Public_key_hash.Map.empty
|
||||||
|
(0 --> (Constants.endorsers_per_block c - 1))
|
||||||
|
|
||||||
|
let check_endorsement_rights ctxt (op : Kind.endorsement Operation.t) =
|
||||||
|
let current_level = Level.current ctxt in
|
||||||
|
let Single (Endorsement { level ; _ }) = op.protocol_data.contents in
|
||||||
|
begin
|
||||||
|
if Raw_level.(succ level = current_level.level) then
|
||||||
|
return (Alpha_context.allowed_endorsements ctxt)
|
||||||
|
else
|
||||||
|
endorsement_rights ctxt (Level.from_raw ctxt level)
|
||||||
|
end >>=? fun map ->
|
||||||
|
match
|
||||||
|
Signature.Public_key_hash.Map.find_first_opt
|
||||||
|
(fun pkh ->
|
||||||
|
let pk, _ = Signature.Public_key_hash.Map.find pkh map in
|
||||||
|
match Operation.raw_check_signature pk op with
|
||||||
|
| Error _ -> false
|
||||||
|
| Ok () -> true)
|
||||||
|
map
|
||||||
|
with
|
||||||
|
| None ->
|
||||||
|
fail Unexpected_endorsement
|
||||||
|
| Some (pkh, (_pk, slots)) ->
|
||||||
|
return (pkh, slots)
|
||||||
|
|
||||||
let select_delegate delegate delegate_list max_priority =
|
let select_delegate delegate delegate_list max_priority =
|
||||||
let rec loop acc l n =
|
let rec loop acc l n =
|
||||||
@ -213,13 +211,6 @@ let first_baking_priorities
|
|||||||
baking_priorities ctxt level >>=? fun delegate_list ->
|
baking_priorities ctxt level >>=? fun delegate_list ->
|
||||||
select_delegate delegate delegate_list max_priority
|
select_delegate delegate delegate_list max_priority
|
||||||
|
|
||||||
let first_endorsement_slots
|
|
||||||
ctxt
|
|
||||||
?(max_priority = Constants.endorsers_per_block ctxt)
|
|
||||||
delegate level =
|
|
||||||
endorsement_priorities ctxt level >>=? fun delegate_list ->
|
|
||||||
select_delegate delegate delegate_list max_priority
|
|
||||||
|
|
||||||
let check_hash hash stamp_threshold =
|
let check_hash hash stamp_threshold =
|
||||||
let bytes = Block_hash.to_bytes hash in
|
let bytes = Block_hash.to_bytes hash in
|
||||||
let word = MBytes.get_int64 bytes 0 in
|
let word = MBytes.get_int64 bytes 0 in
|
||||||
|
@ -12,10 +12,9 @@ open Alpha_context
|
|||||||
open Misc
|
open Misc
|
||||||
|
|
||||||
type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *)
|
type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *)
|
||||||
type error += Invalid_endorsement_slot of int * int (* `Permanent *)
|
|
||||||
type error += Timestamp_too_early of Timestamp.t * Timestamp.t (* `Permanent *)
|
type error += Timestamp_too_early of Timestamp.t * Timestamp.t (* `Permanent *)
|
||||||
type error += Inconsistent_endorsement of public_key_hash list (* `Permanent *)
|
|
||||||
type error += Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t (* `Permanent *)
|
type error += Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t (* `Permanent *)
|
||||||
|
type error += Unexpected_endorsement
|
||||||
|
|
||||||
(** [minimal_time ctxt priority pred_block_time] returns the minimal
|
(** [minimal_time ctxt priority pred_block_time] returns the minimal
|
||||||
time, given the predecessor block timestamp [pred_block_time],
|
time, given the predecessor block timestamp [pred_block_time],
|
||||||
@ -36,8 +35,14 @@ val check_baking_rights:
|
|||||||
* verifies that the endorsement slots are valid ;
|
* verifies that the endorsement slots are valid ;
|
||||||
* verifies that the endorsement slots correspond to the same delegate at the current level;
|
* verifies that the endorsement slots correspond to the same delegate at the current level;
|
||||||
*)
|
*)
|
||||||
val check_endorsements_rights:
|
val check_endorsement_rights:
|
||||||
context -> Level.t -> int list -> public_key tzresult Lwt.t
|
context -> Kind.endorsement Operation.t ->
|
||||||
|
(public_key_hash * int list) tzresult Lwt.t
|
||||||
|
|
||||||
|
val endorsement_rights:
|
||||||
|
context ->
|
||||||
|
Level.t ->
|
||||||
|
(public_key * int list) Signature.Public_key_hash.Map.t tzresult Lwt.t
|
||||||
|
|
||||||
(** Returns the endorsement reward calculated w.r.t a given priotiry. *)
|
(** Returns the endorsement reward calculated w.r.t a given priotiry. *)
|
||||||
val endorsement_reward: context -> block_priority:int -> int -> Tez.t tzresult Lwt.t
|
val endorsement_reward: context -> block_priority:int -> int -> Tez.t tzresult Lwt.t
|
||||||
@ -47,11 +52,6 @@ val endorsement_reward: context -> block_priority:int -> int -> Tez.t tzresult L
|
|||||||
val baking_priorities:
|
val baking_priorities:
|
||||||
context -> Level.t -> public_key lazy_list
|
context -> Level.t -> public_key lazy_list
|
||||||
|
|
||||||
(** [endorsement_priorities ctxt level] is the lazy list of contract's
|
|
||||||
public key hashes that are allowed to endorse for [level]. *)
|
|
||||||
val endorsement_priorities:
|
|
||||||
context -> Level.t -> public_key lazy_list
|
|
||||||
|
|
||||||
(** [first_baking_priorities ctxt ?max_priority contract_hash level]
|
(** [first_baking_priorities ctxt ?max_priority contract_hash level]
|
||||||
is a list of priorities of max [?max_priority] elements, where the
|
is a list of priorities of max [?max_priority] elements, where the
|
||||||
delegate of [contract_hash] is allowed to bake for [level]. If
|
delegate of [contract_hash] is allowed to bake for [level]. If
|
||||||
@ -64,12 +64,6 @@ val first_baking_priorities:
|
|||||||
Level.t ->
|
Level.t ->
|
||||||
int list tzresult Lwt.t
|
int list tzresult Lwt.t
|
||||||
|
|
||||||
val first_endorsement_slots:
|
|
||||||
context ->
|
|
||||||
?max_priority:int ->
|
|
||||||
public_key_hash ->
|
|
||||||
Level.t -> int list tzresult Lwt.t
|
|
||||||
|
|
||||||
(** [check_signature ctxt block id] check if the block is signed with
|
(** [check_signature ctxt block id] check if the block is signed with
|
||||||
the given key *)
|
the given key *)
|
||||||
val check_signature: Block_header.t -> public_key -> unit tzresult Lwt.t
|
val check_signature: Block_header.t -> public_key -> unit tzresult Lwt.t
|
||||||
|
@ -480,25 +480,13 @@ module Endorsing_rights = struct
|
|||||||
end
|
end
|
||||||
|
|
||||||
let endorsement_slots ctxt (level, estimated_time) =
|
let endorsement_slots ctxt (level, estimated_time) =
|
||||||
let max_slot = Constants.endorsers_per_block ctxt in
|
Baking.endorsement_rights ctxt level >>=? fun rights ->
|
||||||
Baking.endorsement_priorities ctxt level >>=? fun contract_list ->
|
return
|
||||||
let build (delegate, slots) = {
|
(Signature.Public_key_hash.Map.fold
|
||||||
level = level.level ; delegate ; slots ; estimated_time
|
(fun delegate (_, slots) acc -> {
|
||||||
} in
|
level = level.level ; delegate ; slots ; estimated_time
|
||||||
let rec loop l map slot =
|
} :: acc)
|
||||||
if Compare.Int.(slot >= max_slot) then
|
rights [])
|
||||||
return (List.map build (Signature.Public_key_hash.Map.bindings map))
|
|
||||||
else
|
|
||||||
let Misc.LCons (pk, next) = l in
|
|
||||||
let delegate = Signature.Public_key.hash pk in
|
|
||||||
let slots =
|
|
||||||
match Signature.Public_key_hash.Map.find_opt delegate map with
|
|
||||||
| None -> [slot]
|
|
||||||
| Some slots -> slot :: slots in
|
|
||||||
let map = Signature.Public_key_hash.Map.add delegate slots map in
|
|
||||||
next () >>=? fun l ->
|
|
||||||
loop l map (slot+1) in
|
|
||||||
loop contract_list Signature.Public_key_hash.Map.empty 0
|
|
||||||
|
|
||||||
let register () =
|
let register () =
|
||||||
let open Services_registration in
|
let open Services_registration in
|
||||||
|
@ -390,9 +390,9 @@ module Forge = struct
|
|||||||
() ({ branch }, Contents_list (Single operation))
|
() ({ branch }, Contents_list (Single operation))
|
||||||
|
|
||||||
let endorsement ctxt
|
let endorsement ctxt
|
||||||
b ~branch ~block ~level ~slots () =
|
b ~branch ~block ~level () =
|
||||||
operation ctxt b ~branch
|
operation ctxt b ~branch
|
||||||
(Endorsements { block ; level ; slots })
|
(Endorsement { block ; level })
|
||||||
|
|
||||||
let proposals ctxt
|
let proposals ctxt
|
||||||
b ~branch ~source ~period ~proposals () =
|
b ~branch ~source ~period ~proposals () =
|
||||||
|
@ -131,7 +131,6 @@ module Forge : sig
|
|||||||
branch:Block_hash.t ->
|
branch:Block_hash.t ->
|
||||||
block:Block_hash.t ->
|
block:Block_hash.t ->
|
||||||
level:Raw_level.t ->
|
level:Raw_level.t ->
|
||||||
slots:int list ->
|
|
||||||
unit -> MBytes.t shell_tzresult Lwt.t
|
unit -> MBytes.t shell_tzresult Lwt.t
|
||||||
|
|
||||||
val proposals:
|
val proposals:
|
||||||
|
@ -215,9 +215,9 @@ let compare_operations op1 op2 =
|
|||||||
let Operation_data op1 = op1.protocol_data in
|
let Operation_data op1 = op1.protocol_data in
|
||||||
let Operation_data op2 = op2.protocol_data in
|
let Operation_data op2 = op2.protocol_data in
|
||||||
match op1.contents, op2.contents with
|
match op1.contents, op2.contents with
|
||||||
| Single (Endorsements _), Single (Endorsements _) -> 0
|
| Single (Endorsement _), Single (Endorsement _) -> 0
|
||||||
| _, Single (Endorsements _) -> 1
|
| _, Single (Endorsement _) -> 1
|
||||||
| Single (Endorsements _), _ -> -1
|
| Single (Endorsement _), _ -> -1
|
||||||
|
|
||||||
| Single (Seed_nonce_revelation _), Single (Seed_nonce_revelation _) -> 0
|
| Single (Seed_nonce_revelation _), Single (Seed_nonce_revelation _) -> 0
|
||||||
| _, Single (Seed_nonce_revelation _) -> 1
|
| _, Single (Seed_nonce_revelation _) -> 1
|
||||||
|
@ -14,7 +14,7 @@ module Kind = struct
|
|||||||
type double_endorsement_evidence = Double_endorsement_evidence_kind
|
type double_endorsement_evidence = Double_endorsement_evidence_kind
|
||||||
type double_baking_evidence = Double_baking_evidence_kind
|
type double_baking_evidence = Double_baking_evidence_kind
|
||||||
type activate_account = Activate_account_kind
|
type activate_account = Activate_account_kind
|
||||||
type endorsements = Endorsements_kind
|
type endorsement = Endorsement_kind
|
||||||
type proposals = Proposals_kind
|
type proposals = Proposals_kind
|
||||||
type ballot = Ballot_kind
|
type ballot = Ballot_kind
|
||||||
type reveal = Reveal_kind
|
type reveal = Reveal_kind
|
||||||
@ -51,18 +51,17 @@ and _ contents_list =
|
|||||||
(('kind * 'rest) Kind.manager ) contents_list
|
(('kind * 'rest) Kind.manager ) contents_list
|
||||||
|
|
||||||
and _ contents =
|
and _ contents =
|
||||||
| Endorsements : {
|
| Endorsement : {
|
||||||
block: Block_hash.t ;
|
block: Block_hash.t ;
|
||||||
level: Raw_level_repr.t ;
|
level: Raw_level_repr.t ;
|
||||||
slots: int list ;
|
} -> Kind.endorsement contents
|
||||||
} -> Kind.endorsements contents
|
|
||||||
| Seed_nonce_revelation : {
|
| Seed_nonce_revelation : {
|
||||||
level: Raw_level_repr.t ;
|
level: Raw_level_repr.t ;
|
||||||
nonce: Seed_repr.nonce ;
|
nonce: Seed_repr.nonce ;
|
||||||
} -> Kind.seed_nonce_revelation contents
|
} -> Kind.seed_nonce_revelation contents
|
||||||
| Double_endorsement_evidence : {
|
| Double_endorsement_evidence : {
|
||||||
op1: Kind.endorsements operation ;
|
op1: Kind.endorsement operation ;
|
||||||
op2: Kind.endorsements operation ;
|
op2: Kind.endorsement operation ;
|
||||||
} -> Kind.double_endorsement_evidence contents
|
} -> Kind.double_endorsement_evidence contents
|
||||||
| Double_baking_evidence : {
|
| Double_baking_evidence : {
|
||||||
bh1: Block_header_repr.t ;
|
bh1: Block_header_repr.t ;
|
||||||
@ -305,25 +304,24 @@ module Encoding = struct
|
|||||||
proj: 'b contents -> 'a ;
|
proj: 'b contents -> 'a ;
|
||||||
inj: 'a -> 'b contents } -> 'b case
|
inj: 'a -> 'b contents } -> 'b case
|
||||||
|
|
||||||
let endorsements_encoding =
|
let endorsement_encoding =
|
||||||
obj3
|
obj2
|
||||||
(req "block" Block_hash.encoding)
|
(req "block" Block_hash.encoding)
|
||||||
(req "level" Raw_level_repr.encoding)
|
(req "level" Raw_level_repr.encoding)
|
||||||
(req "slots" (list int31))
|
|
||||||
|
|
||||||
let endorsement_case =
|
let endorsement_case =
|
||||||
Case {
|
Case {
|
||||||
tag = 0 ;
|
tag = 0 ;
|
||||||
name = "endorsement" ;
|
name = "endorsement" ;
|
||||||
encoding = endorsements_encoding ;
|
encoding = endorsement_encoding ;
|
||||||
select =
|
select =
|
||||||
(function
|
(function
|
||||||
| Contents (Endorsements _ as op) -> Some op
|
| Contents (Endorsement _ as op) -> Some op
|
||||||
| _ -> None) ;
|
| _ -> None) ;
|
||||||
proj =
|
proj =
|
||||||
(fun (Endorsements { block ; level ; slots }) -> (block, level, slots)) ;
|
(fun (Endorsement { block ; level }) -> (block, level)) ;
|
||||||
inj =
|
inj =
|
||||||
(fun (block, level, slots) -> Endorsements { block ; level ; slots })
|
(fun (block, level) -> Endorsement { block ; level })
|
||||||
}
|
}
|
||||||
|
|
||||||
let endorsement_encoding =
|
let endorsement_encoding =
|
||||||
@ -331,9 +329,9 @@ module Encoding = struct
|
|||||||
case (Tag tag) name encoding
|
case (Tag tag) name encoding
|
||||||
(fun o -> Some (proj o))
|
(fun o -> Some (proj o))
|
||||||
(fun x -> inj x) in
|
(fun x -> inj x) in
|
||||||
let to_list : Kind.endorsements contents_list -> _ = function
|
let to_list : Kind.endorsement contents_list -> _ = function
|
||||||
| Single o -> o in
|
| Single o -> o in
|
||||||
let of_list : Kind.endorsements contents -> _ = function
|
let of_list : Kind.endorsement contents -> _ = function
|
||||||
| o -> Single o in
|
| o -> Single o in
|
||||||
def "inlined.endorsement" @@
|
def "inlined.endorsement" @@
|
||||||
conv
|
conv
|
||||||
@ -608,7 +606,7 @@ let acceptable_passes (op : packed_operation) =
|
|||||||
let Operation_data protocol_data = op.protocol_data in
|
let Operation_data protocol_data = op.protocol_data in
|
||||||
match protocol_data.contents with
|
match protocol_data.contents with
|
||||||
|
|
||||||
| Single (Endorsements _) -> [0]
|
| Single (Endorsement _) -> [0]
|
||||||
|
|
||||||
| Single (Proposals _ ) -> [1]
|
| Single (Proposals _ ) -> [1]
|
||||||
| Single (Ballot _ ) -> [1]
|
| Single (Ballot _ ) -> [1]
|
||||||
@ -648,27 +646,30 @@ let () =
|
|||||||
(function Missing_signature -> Some () | _ -> None)
|
(function Missing_signature -> Some () | _ -> None)
|
||||||
(fun () -> Missing_signature)
|
(fun () -> Missing_signature)
|
||||||
|
|
||||||
let check_signature (type kind) key ({ shell ; protocol_data } : kind operation) =
|
let raw_check_signature (type kind) key ({ shell ; protocol_data } : kind operation) =
|
||||||
let check ~watermark contents signature =
|
let check ~watermark contents signature =
|
||||||
let unsigned_operation =
|
let unsigned_operation =
|
||||||
Data_encoding.Binary.to_bytes_exn
|
Data_encoding.Binary.to_bytes_exn
|
||||||
unsigned_operation_encoding (shell, contents) in
|
unsigned_operation_encoding (shell, contents) in
|
||||||
if Signature.check ~watermark key signature unsigned_operation then
|
if Signature.check ~watermark key signature unsigned_operation then
|
||||||
return ()
|
Ok ()
|
||||||
else
|
else
|
||||||
fail Invalid_signature in
|
Error [Invalid_signature] in
|
||||||
match protocol_data.contents, protocol_data.signature with
|
match protocol_data.contents, protocol_data.signature with
|
||||||
| Single _, None ->
|
| Single _, None ->
|
||||||
fail Missing_signature
|
Error [Missing_signature]
|
||||||
| Cons _, None ->
|
| Cons _, None ->
|
||||||
fail Missing_signature
|
Error [Missing_signature]
|
||||||
| Single (Endorsements _) as contents, Some signature ->
|
| Single (Endorsement _) as contents, Some signature ->
|
||||||
check ~watermark:Endorsement (Contents_list contents) signature
|
check ~watermark:Endorsement (Contents_list contents) signature
|
||||||
| Single _ as contents, Some signature ->
|
| Single _ as contents, Some signature ->
|
||||||
check ~watermark:Generic_operation (Contents_list contents) signature
|
check ~watermark:Generic_operation (Contents_list contents) signature
|
||||||
| Cons _ as contents, Some signature ->
|
| Cons _ as contents, Some signature ->
|
||||||
check ~watermark:Generic_operation (Contents_list contents) signature
|
check ~watermark:Generic_operation (Contents_list contents) signature
|
||||||
|
|
||||||
|
let check_signature pk op =
|
||||||
|
Lwt.return (raw_check_signature pk op)
|
||||||
|
|
||||||
let hash_raw = Operation.hash
|
let hash_raw = Operation.hash
|
||||||
let hash (o : _ operation) =
|
let hash (o : _ operation) =
|
||||||
let proto =
|
let proto =
|
||||||
@ -702,8 +703,8 @@ let equal_contents_kind
|
|||||||
: type a b. a contents -> b contents -> (a, b) eq option
|
: type a b. a contents -> b contents -> (a, b) eq option
|
||||||
= fun op1 op2 ->
|
= fun op1 op2 ->
|
||||||
match op1, op2 with
|
match op1, op2 with
|
||||||
| Endorsements _, Endorsements _ -> Some Eq
|
| Endorsement _, Endorsement _ -> Some Eq
|
||||||
| Endorsements _, _ -> None
|
| Endorsement _, _ -> None
|
||||||
| Seed_nonce_revelation _, Seed_nonce_revelation _ -> Some Eq
|
| Seed_nonce_revelation _, Seed_nonce_revelation _ -> Some Eq
|
||||||
| Seed_nonce_revelation _, _ -> None
|
| Seed_nonce_revelation _, _ -> None
|
||||||
| Double_endorsement_evidence _, Double_endorsement_evidence _ -> Some Eq
|
| Double_endorsement_evidence _, Double_endorsement_evidence _ -> Some Eq
|
||||||
|
@ -14,7 +14,7 @@ module Kind : sig
|
|||||||
type double_endorsement_evidence = Double_endorsement_evidence_kind
|
type double_endorsement_evidence = Double_endorsement_evidence_kind
|
||||||
type double_baking_evidence = Double_baking_evidence_kind
|
type double_baking_evidence = Double_baking_evidence_kind
|
||||||
type activate_account = Activate_account_kind
|
type activate_account = Activate_account_kind
|
||||||
type endorsements = Endorsements_kind
|
type endorsement = Endorsement_kind
|
||||||
type proposals = Proposals_kind
|
type proposals = Proposals_kind
|
||||||
type ballot = Ballot_kind
|
type ballot = Ballot_kind
|
||||||
type reveal = Reveal_kind
|
type reveal = Reveal_kind
|
||||||
@ -52,18 +52,17 @@ and _ contents_list =
|
|||||||
(('kind * 'rest) Kind.manager ) contents_list
|
(('kind * 'rest) Kind.manager ) contents_list
|
||||||
|
|
||||||
and _ contents =
|
and _ contents =
|
||||||
| Endorsements : {
|
| Endorsement : {
|
||||||
block: Block_hash.t ;
|
block: Block_hash.t ;
|
||||||
level: Raw_level_repr.t ;
|
level: Raw_level_repr.t ;
|
||||||
slots: int list ;
|
} -> Kind.endorsement contents
|
||||||
} -> Kind.endorsements contents
|
|
||||||
| Seed_nonce_revelation : {
|
| Seed_nonce_revelation : {
|
||||||
level: Raw_level_repr.t ;
|
level: Raw_level_repr.t ;
|
||||||
nonce: Seed_repr.nonce ;
|
nonce: Seed_repr.nonce ;
|
||||||
} -> Kind.seed_nonce_revelation contents
|
} -> Kind.seed_nonce_revelation contents
|
||||||
| Double_endorsement_evidence : {
|
| Double_endorsement_evidence : {
|
||||||
op1: Kind.endorsements operation ;
|
op1: Kind.endorsement operation ;
|
||||||
op2: Kind.endorsements operation ;
|
op2: Kind.endorsement operation ;
|
||||||
} -> Kind.double_endorsement_evidence contents
|
} -> Kind.double_endorsement_evidence contents
|
||||||
| Double_baking_evidence : {
|
| Double_baking_evidence : {
|
||||||
bh1: Block_header_repr.t ;
|
bh1: Block_header_repr.t ;
|
||||||
@ -166,6 +165,9 @@ type error += Invalid_signature (* `Permanent *)
|
|||||||
|
|
||||||
val check_signature:
|
val check_signature:
|
||||||
Signature.Public_key.t -> _ operation -> unit tzresult Lwt.t
|
Signature.Public_key.t -> _ operation -> unit tzresult Lwt.t
|
||||||
|
val raw_check_signature:
|
||||||
|
Signature.Public_key.t -> _ operation -> unit tzresult
|
||||||
|
|
||||||
|
|
||||||
val internal_operation_encoding:
|
val internal_operation_encoding:
|
||||||
packed_internal_operation Data_encoding.t
|
packed_internal_operation Data_encoding.t
|
||||||
@ -183,7 +185,7 @@ module Encoding : sig
|
|||||||
proj: 'b contents -> 'a ;
|
proj: 'b contents -> 'a ;
|
||||||
inj: 'a -> 'b contents } -> 'b case
|
inj: 'a -> 'b contents } -> 'b case
|
||||||
|
|
||||||
val endorsement_case: Kind.endorsements case
|
val endorsement_case: Kind.endorsement case
|
||||||
val seed_nonce_revelation_case: Kind.seed_nonce_revelation case
|
val seed_nonce_revelation_case: Kind.seed_nonce_revelation case
|
||||||
val double_endorsement_evidence_case: Kind.double_endorsement_evidence case
|
val double_endorsement_evidence_case: Kind.double_endorsement_evidence case
|
||||||
val double_baking_evidence_case: Kind.double_baking_evidence case
|
val double_baking_evidence_case: Kind.double_baking_evidence case
|
||||||
|
@ -16,8 +16,9 @@ type t = {
|
|||||||
level: Level_repr.t ;
|
level: Level_repr.t ;
|
||||||
timestamp: Time.t ;
|
timestamp: Time.t ;
|
||||||
fitness: Int64.t ;
|
fitness: Int64.t ;
|
||||||
endorsements_received: Int_set.t ;
|
|
||||||
deposits: Tez_repr.t Signature.Public_key_hash.Map.t ;
|
deposits: Tez_repr.t Signature.Public_key_hash.Map.t ;
|
||||||
|
allowed_endorsements:
|
||||||
|
(Signature.Public_key.t * int list) Signature.Public_key_hash.Map.t ;
|
||||||
fees: Tez_repr.t ;
|
fees: Tez_repr.t ;
|
||||||
rewards: Tez_repr.t ;
|
rewards: Tez_repr.t ;
|
||||||
block_gas: Z.t ;
|
block_gas: Z.t ;
|
||||||
@ -39,8 +40,14 @@ let first_level ctxt = ctxt.first_level
|
|||||||
let constants ctxt = ctxt.constants
|
let constants ctxt = ctxt.constants
|
||||||
let recover ctxt = ctxt.context
|
let recover ctxt = ctxt.context
|
||||||
|
|
||||||
let record_endorsement ctxt k = { ctxt with endorsements_received = Int_set.add k ctxt.endorsements_received }
|
let record_endorsement ctxt k =
|
||||||
let endorsement_already_recorded ctxt k = Int_set.mem k ctxt.endorsements_received
|
{ ctxt with
|
||||||
|
allowed_endorsements =
|
||||||
|
Signature.Public_key_hash.Map.remove k ctxt.allowed_endorsements }
|
||||||
|
let init_endorsements ctxt allowed_endorsements =
|
||||||
|
{ ctxt with allowed_endorsements }
|
||||||
|
let allowed_endorsements ctxt =
|
||||||
|
ctxt.allowed_endorsements
|
||||||
|
|
||||||
type error += Too_many_internal_operations (* `Permanent *)
|
type error += Too_many_internal_operations (* `Permanent *)
|
||||||
|
|
||||||
@ -402,7 +409,7 @@ let prepare ~level ~timestamp ~fitness ctxt =
|
|||||||
return {
|
return {
|
||||||
context = ctxt ; constants ; level ;
|
context = ctxt ; constants ; level ;
|
||||||
timestamp ; fitness ; first_level ;
|
timestamp ; fitness ; first_level ;
|
||||||
endorsements_received = Int_set.empty ;
|
allowed_endorsements = Signature.Public_key_hash.Map.empty ;
|
||||||
fees = Tez_repr.zero ;
|
fees = Tez_repr.zero ;
|
||||||
rewards = Tez_repr.zero ;
|
rewards = Tez_repr.zero ;
|
||||||
deposits = Signature.Public_key_hash.Map.empty ;
|
deposits = Signature.Public_key_hash.Map.empty ;
|
||||||
@ -454,7 +461,7 @@ let register_resolvers enc resolve =
|
|||||||
level = Level_repr.root Raw_level_repr.root ;
|
level = Level_repr.root Raw_level_repr.root ;
|
||||||
timestamp = Time.of_seconds 0L ;
|
timestamp = Time.of_seconds 0L ;
|
||||||
fitness = 0L ;
|
fitness = 0L ;
|
||||||
endorsements_received = Int_set.empty ;
|
allowed_endorsements = Signature.Public_key_hash.Map.empty ;
|
||||||
fees = Tez_repr.zero ;
|
fees = Tez_repr.zero ;
|
||||||
rewards = Tez_repr.zero ;
|
rewards = Tez_repr.zero ;
|
||||||
deposits = Signature.Public_key_hash.Map.empty ;
|
deposits = Signature.Public_key_hash.Map.empty ;
|
||||||
|
@ -192,9 +192,6 @@ end
|
|||||||
|
|
||||||
include T with type t := t and type context := context
|
include T with type t := t and type context := context
|
||||||
|
|
||||||
val record_endorsement: context -> int -> context
|
|
||||||
val endorsement_already_recorded: context -> int -> bool
|
|
||||||
|
|
||||||
(** Initialize the local nonce used for preventing a script to
|
(** Initialize the local nonce used for preventing a script to
|
||||||
duplicate an internal operation to replay it. *)
|
duplicate an internal operation to replay it. *)
|
||||||
val reset_internal_nonce: context -> context
|
val reset_internal_nonce: context -> context
|
||||||
@ -207,3 +204,13 @@ val record_internal_nonce: context -> int -> context
|
|||||||
|
|
||||||
(** Check is the internal operation nonce has been taken. *)
|
(** Check is the internal operation nonce has been taken. *)
|
||||||
val internal_nonce_already_recorded: context -> int -> bool
|
val internal_nonce_already_recorded: context -> int -> bool
|
||||||
|
|
||||||
|
val record_endorsement:
|
||||||
|
context -> Signature.Public_key_hash.t -> context
|
||||||
|
val allowed_endorsements:
|
||||||
|
context ->
|
||||||
|
(Signature.Public_key.t * int list) Signature.Public_key_hash.Map.t
|
||||||
|
val init_endorsements:
|
||||||
|
context ->
|
||||||
|
(Signature.Public_key.t * int list) Signature.Public_key_hash.Map.t ->
|
||||||
|
context
|
||||||
|
@ -52,9 +52,9 @@ let valid_double_endorsement_evidence () =
|
|||||||
|
|
||||||
block_fork b >>=? fun (blk_a, blk_b) ->
|
block_fork b >>=? fun (blk_a, blk_b) ->
|
||||||
|
|
||||||
Context.get_endorser (B blk_a) 0 >>=? fun delegate ->
|
Context.get_endorser (B blk_a) >>=? fun (delegate, _slots) ->
|
||||||
Op.endorsement ~delegate (B blk_a) [0] >>=? fun endorsement_a ->
|
Op.endorsement ~delegate (B blk_a) () >>=? fun endorsement_a ->
|
||||||
Op.endorsement ~delegate (B blk_b) [0] >>=? fun endorsement_b ->
|
Op.endorsement ~delegate (B blk_b) () >>=? fun endorsement_b ->
|
||||||
Block.bake ~operations:[Operation.pack endorsement_a] blk_a >>=? fun blk_a ->
|
Block.bake ~operations:[Operation.pack endorsement_a] blk_a >>=? fun blk_a ->
|
||||||
(* Block.bake ~operations:[endorsement_b] blk_b >>=? fun _ -> *)
|
(* Block.bake ~operations:[endorsement_b] blk_b >>=? fun _ -> *)
|
||||||
|
|
||||||
@ -82,7 +82,7 @@ let invalid_double_endorsement () =
|
|||||||
Context.init 10 >>=? fun (b, _) ->
|
Context.init 10 >>=? fun (b, _) ->
|
||||||
Block.bake b >>=? fun b ->
|
Block.bake b >>=? fun b ->
|
||||||
|
|
||||||
Op.endorsement (B b) [0] >>=? fun endorsement ->
|
Op.endorsement (B b) () >>=? fun endorsement ->
|
||||||
Block.bake ~operation:(Operation.pack endorsement) b >>=? fun b ->
|
Block.bake ~operation:(Operation.pack endorsement) b >>=? fun b ->
|
||||||
|
|
||||||
Op.double_endorsement (B b) endorsement endorsement >>=? fun operation ->
|
Op.double_endorsement (B b) endorsement endorsement >>=? fun operation ->
|
||||||
@ -97,9 +97,9 @@ let too_early_double_endorsement_evidence () =
|
|||||||
Context.init 2 >>=? fun (b, _) ->
|
Context.init 2 >>=? fun (b, _) ->
|
||||||
block_fork b >>=? fun (blk_a, blk_b) ->
|
block_fork b >>=? fun (blk_a, blk_b) ->
|
||||||
|
|
||||||
Context.get_endorser (B blk_a) 0 >>=? fun delegate ->
|
Context.get_endorser (B blk_a) >>=? fun (delegate, _) ->
|
||||||
Op.endorsement ~delegate (B blk_a) [0] >>=? fun endorsement_a ->
|
Op.endorsement ~delegate (B blk_a) () >>=? fun endorsement_a ->
|
||||||
Op.endorsement ~delegate (B blk_b) [0] >>=? fun endorsement_b ->
|
Op.endorsement ~delegate (B blk_b) () >>=? fun endorsement_b ->
|
||||||
|
|
||||||
Op.double_endorsement (B b) endorsement_a endorsement_b >>=? fun operation ->
|
Op.double_endorsement (B b) endorsement_a endorsement_b >>=? fun operation ->
|
||||||
Block.bake ~operation b >>= fun res ->
|
Block.bake ~operation b >>= fun res ->
|
||||||
@ -116,9 +116,9 @@ let too_late_double_endorsement_evidence () =
|
|||||||
|
|
||||||
block_fork b >>=? fun (blk_a, blk_b) ->
|
block_fork b >>=? fun (blk_a, blk_b) ->
|
||||||
|
|
||||||
Context.get_endorser (B blk_a) 0 >>=? fun delegate ->
|
Context.get_endorser (B blk_a) >>=? fun (delegate, _slots) ->
|
||||||
Op.endorsement ~delegate (B blk_a) [0] >>=? fun endorsement_a ->
|
Op.endorsement ~delegate (B blk_a) () >>=? fun endorsement_a ->
|
||||||
Op.endorsement ~delegate (B blk_b) [0] >>=? fun endorsement_b ->
|
Op.endorsement ~delegate (B blk_b) () >>=? fun endorsement_b ->
|
||||||
|
|
||||||
fold_left_s (fun blk _ -> Block.bake_until_cycle_end blk)
|
fold_left_s (fun blk _ -> Block.bake_until_cycle_end blk)
|
||||||
blk_a (1 -- (preserved_cycles + 1)) >>=? fun blk ->
|
blk_a (1 -- (preserved_cycles + 1)) >>=? fun blk ->
|
||||||
@ -134,12 +134,13 @@ let too_late_double_endorsement_evidence () =
|
|||||||
let different_delegates () =
|
let different_delegates () =
|
||||||
Context.init 2 >>=? fun (b, _) ->
|
Context.init 2 >>=? fun (b, _) ->
|
||||||
|
|
||||||
block_fork b >>=? fun (blk_a, blk_b) ->
|
Block.bake b >>=? fun b ->
|
||||||
get_first_different_endorsers (B blk_a)
|
Block.bake b >>=? fun blk_a ->
|
||||||
>>=? fun (endorser_a, endorser_b) ->
|
Block.bake b >>=? fun blk_b ->
|
||||||
|
get_first_different_endorsers (B blk_a) >>=? fun (endorser_a, endorser_b) ->
|
||||||
|
|
||||||
Op.endorsement ~delegate:endorser_a.delegate (B blk_a) endorser_a.slots >>=? fun e_a ->
|
Op.endorsement ~delegate:endorser_a.delegate (B blk_a) () >>=? fun e_a ->
|
||||||
Op.endorsement ~delegate:endorser_b.delegate (B blk_b) endorser_b.slots >>=? fun e_b ->
|
Op.endorsement ~delegate:endorser_b.delegate (B blk_b) () >>=? fun e_b ->
|
||||||
Op.double_endorsement (B blk_a) e_a e_b >>=? fun operation ->
|
Op.double_endorsement (B blk_a) e_a e_b >>=? fun operation ->
|
||||||
Block.bake ~operation blk_a >>= fun res ->
|
Block.bake ~operation blk_a >>= fun res ->
|
||||||
Assert.proto_error ~loc:__LOC__ res begin function
|
Assert.proto_error ~loc:__LOC__ res begin function
|
||||||
@ -153,10 +154,10 @@ let wrong_delegate () =
|
|||||||
|
|
||||||
block_fork b >>=? fun (blk_a, blk_b) ->
|
block_fork b >>=? fun (blk_a, blk_b) ->
|
||||||
get_first_different_endorsers (B blk_a)
|
get_first_different_endorsers (B blk_a)
|
||||||
>>=? fun (endorser_a, endorser_b) ->
|
>>=? fun (_endorser_a, endorser_b) ->
|
||||||
|
|
||||||
Op.endorsement ~delegate:endorser_b.delegate (B blk_a) endorser_a.slots >>=? fun endorsement_a ->
|
Op.endorsement ~delegate:endorser_b.delegate (B blk_a) () >>=? fun endorsement_a ->
|
||||||
Op.endorsement ~delegate:endorser_b.delegate (B blk_b) endorser_b.slots >>=? fun endorsement_b ->
|
Op.endorsement ~delegate:endorser_b.delegate (B blk_b) () >>=? fun endorsement_b ->
|
||||||
|
|
||||||
Op.double_endorsement (B blk_a) endorsement_a endorsement_b >>=? fun operation ->
|
Op.double_endorsement (B blk_a) endorsement_a endorsement_b >>=? fun operation ->
|
||||||
Block.bake ~operation blk_a >>= fun e ->
|
Block.bake ~operation blk_a >>= fun e ->
|
||||||
@ -173,3 +174,4 @@ let tests = [
|
|||||||
Test.tztest "different delegates" `Quick different_delegates ;
|
Test.tztest "different delegates" `Quick different_delegates ;
|
||||||
Test.tztest "wrong delegate" `Quick wrong_delegate ;
|
Test.tztest "wrong delegate" `Quick wrong_delegate ;
|
||||||
]
|
]
|
||||||
|
|
||||||
|
@ -61,17 +61,17 @@ let assert_endorser_balance_consistency ~loc ?(priority=0) ?(nb_baking=0) ~nb_en
|
|||||||
(** Apply a single endorsement from the slot 0 endorser *)
|
(** Apply a single endorsement from the slot 0 endorser *)
|
||||||
let simple_endorsement () =
|
let simple_endorsement () =
|
||||||
Context.init 5 >>=? fun (b, _) ->
|
Context.init 5 >>=? fun (b, _) ->
|
||||||
let slot = 1 in
|
Context.get_endorser (B b) >>=? fun (delegate, slots) ->
|
||||||
Context.get_endorser (B b) slot >>=? fun endorser ->
|
Op.endorsement ~delegate (B b) () >>=? fun op ->
|
||||||
Op.endorsement ~delegate:endorser (B b) [slot] >>=? fun op ->
|
|
||||||
Context.Contract.balance (B b)
|
Context.Contract.balance (B b)
|
||||||
(Contract.implicit_contract endorser) >>=? fun initial_balance ->
|
(Contract.implicit_contract delegate) >>=? fun initial_balance ->
|
||||||
Block.bake
|
Block.bake
|
||||||
~policy:(Excluding [endorser])
|
~policy:(Excluding [delegate])
|
||||||
~operations:[Operation.pack op]
|
~operations:[Operation.pack op]
|
||||||
b >>=? fun b2 ->
|
b >>=? fun b2 ->
|
||||||
assert_endorser_balance_consistency ~loc:__LOC__
|
assert_endorser_balance_consistency ~loc:__LOC__
|
||||||
(B b2) ~nb_endorsement:1 endorser initial_balance
|
(B b2) ~nb_endorsement:(List.length slots)
|
||||||
|
delegate initial_balance
|
||||||
|
|
||||||
(** Apply a maximum number of endorsement. A endorser can be selected
|
(** Apply a maximum number of endorsement. A endorser can be selected
|
||||||
twice. *)
|
twice. *)
|
||||||
@ -86,7 +86,7 @@ let max_endorsement () =
|
|||||||
fold_left_s (fun (delegates, ops, balances) (endorser : Alpha_services.Delegate.Endorsing_rights.t) ->
|
fold_left_s (fun (delegates, ops, balances) (endorser : Alpha_services.Delegate.Endorsing_rights.t) ->
|
||||||
let delegate = endorser.delegate in
|
let delegate = endorser.delegate in
|
||||||
Context.Contract.balance (B b) (Contract.implicit_contract delegate) >>=? fun balance ->
|
Context.Contract.balance (B b) (Contract.implicit_contract delegate) >>=? fun balance ->
|
||||||
Op.endorsement ~delegate (B b) endorser.slots >>=? fun op ->
|
Op.endorsement ~delegate (B b) () >>=? fun op ->
|
||||||
return (delegate :: delegates, Operation.pack op :: ops, (List.length endorser.slots, balance) :: balances)
|
return (delegate :: delegates, Operation.pack op :: ops, (List.length endorser.slots, balance) :: balances)
|
||||||
)
|
)
|
||||||
([], [], [])
|
([], [], [])
|
||||||
@ -108,19 +108,19 @@ let consistent_priority () =
|
|||||||
Block.bake ~policy:(By_priority 15) b >>=? fun b ->
|
Block.bake ~policy:(By_priority 15) b >>=? fun b ->
|
||||||
|
|
||||||
(* Grab an endorser that didn't bake the previous block *)
|
(* Grab an endorser that didn't bake the previous block *)
|
||||||
Context.get_endorser (B b) 0 >>=? fun endorser_0 ->
|
Context.get_endorsers (B b) >>=? fun endorsers ->
|
||||||
Context.get_endorser (B b) 1 >>=? fun endorser_1 ->
|
let endorser =
|
||||||
let (endorser, slot) =
|
List.find
|
||||||
if endorser_0 = baker_account then endorser_1, 1 else endorser_0, 0
|
(fun e -> e.Delegate_services.Endorsing_rights.delegate <> baker_account)
|
||||||
in
|
endorsers in
|
||||||
Context.Contract.balance (B b) (Contract.implicit_contract endorser) >>=? fun balance ->
|
Context.Contract.balance (B b) (Contract.implicit_contract endorser.delegate) >>=? fun balance ->
|
||||||
|
|
||||||
Op.endorsement ~delegate:endorser (B b) [slot] >>=? fun operation ->
|
Op.endorsement ~delegate:endorser.delegate (B b) () >>=? fun operation ->
|
||||||
let operation = Operation.pack operation in
|
let operation = Operation.pack operation in
|
||||||
Block.bake ~policy:( Excluding [ endorser ] ) ~operation b >>=? fun b ->
|
Block.bake ~policy:( Excluding [ endorser.delegate ] ) ~operation b >>=? fun b ->
|
||||||
|
|
||||||
assert_endorser_balance_consistency ~loc:__LOC__ ~priority:15
|
assert_endorser_balance_consistency ~loc:__LOC__ ~priority:15
|
||||||
(B b) ~nb_endorsement:1 endorser balance
|
(B b) ~nb_endorsement:(List.length endorser.slots) endorser.delegate balance
|
||||||
|
|
||||||
(** Check every 32 endorser's balances are consistent with a different piority *)
|
(** Check every 32 endorser's balances are consistent with a different piority *)
|
||||||
let consistent_priorities () =
|
let consistent_priorities () =
|
||||||
@ -133,19 +133,19 @@ let consistent_priorities () =
|
|||||||
Block.bake ~policy:(By_priority priority) b >>=? fun b ->
|
Block.bake ~policy:(By_priority priority) b >>=? fun b ->
|
||||||
|
|
||||||
(* Grab an endorser that didn't bake the previous block *)
|
(* Grab an endorser that didn't bake the previous block *)
|
||||||
Context.get_endorser (B b) 0 >>=? fun endorser_0 ->
|
Context.get_endorsers (B b) >>=? fun endorsers ->
|
||||||
Context.get_endorser (B b) 1 >>=? fun endorser_1 ->
|
let endorser =
|
||||||
let (endorser, slot) =
|
List.find
|
||||||
if endorser_0 = baker_account then endorser_1, 1 else endorser_0, 0
|
(fun e -> e.Delegate_services.Endorsing_rights.delegate <> baker_account)
|
||||||
in
|
endorsers in
|
||||||
|
|
||||||
Context.Contract.balance (B b) (Contract.implicit_contract endorser) >>=? fun balance ->
|
Context.Contract.balance (B b) (Contract.implicit_contract endorser.delegate) >>=? fun balance ->
|
||||||
Op.endorsement ~delegate:endorser (B b) [slot] >>=? fun operation ->
|
Op.endorsement ~delegate:endorser.delegate (B b) () >>=? fun operation ->
|
||||||
let operation = Operation.pack operation in
|
let operation = Operation.pack operation in
|
||||||
Block.bake ~policy:( Excluding [ endorser ] ) ~operation b >>=? fun b ->
|
Block.bake ~policy:( Excluding [ endorser.delegate ] ) ~operation b >>=? fun b ->
|
||||||
|
|
||||||
assert_endorser_balance_consistency ~loc:__LOC__ ~priority
|
assert_endorser_balance_consistency ~loc:__LOC__ ~priority
|
||||||
(B b) ~nb_endorsement:1 endorser balance
|
(B b) ~nb_endorsement:(List.length endorser.slots) endorser.delegate balance
|
||||||
) priorities
|
) priorities
|
||||||
|
|
||||||
(** Check that after a cycle the endorser gets his reward *)
|
(** Check that after a cycle the endorser gets his reward *)
|
||||||
@ -154,10 +154,9 @@ let reward_retrieval () =
|
|||||||
Context.get_constants (B b) >>=? fun Constants.
|
Context.get_constants (B b) >>=? fun Constants.
|
||||||
{ parametric = { preserved_cycles ; endorsement_reward ; _ } ; _ } ->
|
{ parametric = { preserved_cycles ; endorsement_reward ; _ } ; _ } ->
|
||||||
|
|
||||||
let slot = 0 in
|
Context.get_endorser (B b) >>=? fun (endorser, slots) ->
|
||||||
Context.get_endorser (B b) slot >>=? fun endorser ->
|
|
||||||
Context.Contract.balance (B b) (Contract.implicit_contract endorser) >>=? fun balance ->
|
Context.Contract.balance (B b) (Contract.implicit_contract endorser) >>=? fun balance ->
|
||||||
Op.endorsement ~delegate:endorser (B b) [slot] >>=? fun operation ->
|
Op.endorsement ~delegate:endorser (B b) () >>=? fun operation ->
|
||||||
let operation = Operation.pack operation in
|
let operation = Operation.pack operation in
|
||||||
Block.bake ~policy:(Excluding [ endorser ]) ~operation b >>=? fun b ->
|
Block.bake ~policy:(Excluding [ endorser ]) ~operation b >>=? fun b ->
|
||||||
(* Bake (preserved_cycles + 1) cycles *)
|
(* Bake (preserved_cycles + 1) cycles *)
|
||||||
@ -165,7 +164,8 @@ let reward_retrieval () =
|
|||||||
Block.bake_until_cycle_end ~policy:(Excluding [ endorser ]) b
|
Block.bake_until_cycle_end ~policy:(Excluding [ endorser ]) b
|
||||||
) b (0 -- preserved_cycles) >>=? fun b ->
|
) b (0 -- preserved_cycles) >>=? fun b ->
|
||||||
|
|
||||||
Assert.balance_was_credited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser) balance endorsement_reward
|
Lwt.return Tez.(endorsement_reward *? Int64.of_int (List.length slots)) >>=? fun reward ->
|
||||||
|
Assert.balance_was_credited ~loc:__LOC__ (B b) (Contract.implicit_contract endorser) balance reward
|
||||||
|
|
||||||
(****************************************************************)
|
(****************************************************************)
|
||||||
(* The following test scenarios are supposed to raise errors. *)
|
(* The following test scenarios are supposed to raise errors. *)
|
||||||
@ -176,9 +176,9 @@ let reward_retrieval () =
|
|||||||
let wrong_endorsement_predecessor () =
|
let wrong_endorsement_predecessor () =
|
||||||
Context.init 5 >>=? fun (b, _) ->
|
Context.init 5 >>=? fun (b, _) ->
|
||||||
|
|
||||||
Context.get_endorser (B b) 0 >>=? fun genesis_endorser ->
|
Context.get_endorser (B b) >>=? fun (genesis_endorser, _slots) ->
|
||||||
Block.bake b >>=? fun b' ->
|
Block.bake b >>=? fun b' ->
|
||||||
Op.endorsement ~delegate:genesis_endorser ~signing_context:(B b') (B b) [0] >>=? fun operation ->
|
Op.endorsement ~delegate:genesis_endorser ~signing_context:(B b') (B b) () >>=? fun operation ->
|
||||||
let operation = Operation.pack operation in
|
let operation = Operation.pack operation in
|
||||||
Block.bake ~operation b' >>= fun res ->
|
Block.bake ~operation b' >>= fun res ->
|
||||||
|
|
||||||
@ -193,7 +193,7 @@ let invalid_endorsement_level () =
|
|||||||
Context.init 5 >>=? fun (b, _) ->
|
Context.init 5 >>=? fun (b, _) ->
|
||||||
Context.get_level (B b) >>=? fun genesis_level ->
|
Context.get_level (B b) >>=? fun genesis_level ->
|
||||||
Block.bake b >>=? fun b ->
|
Block.bake b >>=? fun b ->
|
||||||
Op.endorsement ~level:genesis_level (B b) [0] >>=? fun operation ->
|
Op.endorsement ~level:genesis_level (B b) () >>=? fun operation ->
|
||||||
let operation = Operation.pack operation in
|
let operation = Operation.pack operation in
|
||||||
Block.bake ~operation b >>= fun res ->
|
Block.bake ~operation b >>= fun res ->
|
||||||
|
|
||||||
@ -206,31 +206,15 @@ let invalid_endorsement_level () =
|
|||||||
let duplicate_endorsement () =
|
let duplicate_endorsement () =
|
||||||
Context.init 5 >>=? fun (b, _) ->
|
Context.init 5 >>=? fun (b, _) ->
|
||||||
Incremental.begin_construction b >>=? fun inc ->
|
Incremental.begin_construction b >>=? fun inc ->
|
||||||
Op.endorsement (B b) [0] >>=? fun operation ->
|
Op.endorsement (B b) () >>=? fun operation ->
|
||||||
let operation = Operation.pack operation in
|
let operation = Operation.pack operation in
|
||||||
Incremental.add_operation inc operation >>=? fun inc ->
|
Incremental.add_operation inc operation >>=? fun inc ->
|
||||||
Op.endorsement (B b) [0] >>=? fun operation ->
|
Op.endorsement (B b) () >>=? fun operation ->
|
||||||
let operation = Operation.pack operation in
|
let operation = Operation.pack operation in
|
||||||
Incremental.add_operation inc operation >>= fun res ->
|
Incremental.add_operation inc operation >>= fun res ->
|
||||||
|
|
||||||
Assert.proto_error ~loc:__LOC__ res begin function
|
Assert.proto_error ~loc:__LOC__ res begin function
|
||||||
| Apply.Duplicate_endorsement _ -> true
|
| Baking.Unexpected_endorsement -> true
|
||||||
| _ -> false
|
|
||||||
end
|
|
||||||
|
|
||||||
(** Invalid_endorsement_slot : making an endorsement with an invalid slot *)
|
|
||||||
let invalid_endorsement_slot () =
|
|
||||||
Context.init 64 >>=? fun (b, _) ->
|
|
||||||
Context.get_constants (B b) >>=? fun Constants.
|
|
||||||
{ parametric = { endorsers_per_block ; _ } ; _ } ->
|
|
||||||
Context.get_endorser (B b) 0 >>=? fun endorser ->
|
|
||||||
Op.endorsement ~delegate:endorser (B b) [endorsers_per_block + 1] >>=? fun operation ->
|
|
||||||
|
|
||||||
let operation = Operation.pack operation in
|
|
||||||
Block.bake ~operation b >>= fun res ->
|
|
||||||
|
|
||||||
Assert.proto_error ~loc:__LOC__ res begin function
|
|
||||||
| Baking.Invalid_endorsement_slot _ -> true
|
|
||||||
| _ -> false
|
| _ -> false
|
||||||
end
|
end
|
||||||
|
|
||||||
@ -276,7 +260,5 @@ let tests = [
|
|||||||
Test.tztest "Wrong endorsement predecessor" `Quick wrong_endorsement_predecessor ;
|
Test.tztest "Wrong endorsement predecessor" `Quick wrong_endorsement_predecessor ;
|
||||||
Test.tztest "Invalid endorsement level" `Quick invalid_endorsement_level ;
|
Test.tztest "Invalid endorsement level" `Quick invalid_endorsement_level ;
|
||||||
Test.tztest "Duplicate endorsement" `Quick duplicate_endorsement ;
|
Test.tztest "Duplicate endorsement" `Quick duplicate_endorsement ;
|
||||||
|
|
||||||
Test.tztest "Invalid endorsement slot" `Quick invalid_endorsement_slot ;
|
|
||||||
Test.tztest "Not enough for deposit" `Quick no_enough_for_deposit ;
|
Test.tztest "Not enough for deposit" `Quick no_enough_for_deposit ;
|
||||||
]
|
]
|
||||||
|
@ -66,13 +66,10 @@ end
|
|||||||
let get_endorsers ctxt =
|
let get_endorsers ctxt =
|
||||||
Alpha_services.Delegate.Endorsing_rights.get rpc_ctxt ctxt
|
Alpha_services.Delegate.Endorsing_rights.get rpc_ctxt ctxt
|
||||||
|
|
||||||
let get_endorser ctxt slot =
|
let get_endorser ctxt =
|
||||||
Alpha_services.Delegate.Endorsing_rights.get
|
Alpha_services.Delegate.Endorsing_rights.get rpc_ctxt ctxt >>=? fun endorsers ->
|
||||||
rpc_ctxt ctxt >>=? fun endorsers ->
|
let endorser = List.hd endorsers in
|
||||||
try return (List.find (fun {Alpha_services.Delegate.Endorsing_rights.slots} -> List.mem slot slots) endorsers).delegate
|
return (endorser.delegate, endorser.slots)
|
||||||
with _ ->
|
|
||||||
failwith "Failed to lookup endorsers for ctxt %a, slot %d."
|
|
||||||
Block_hash.pp_short (branch ctxt) slot
|
|
||||||
|
|
||||||
let get_bakers ctxt =
|
let get_bakers ctxt =
|
||||||
Alpha_services.Delegate.Baking_rights.get
|
Alpha_services.Delegate.Baking_rights.get
|
||||||
|
@ -20,7 +20,7 @@ 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_endorsers: t -> Alpha_services.Delegate.Endorsing_rights.t list tzresult Lwt.t
|
||||||
|
|
||||||
val get_endorser: t -> int -> public_key_hash 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_bakers: t -> public_key_hash list tzresult Lwt.t
|
||||||
|
|
||||||
|
@ -25,24 +25,25 @@ let sign ?(watermark = Signature.Generic_operation)
|
|||||||
} ;
|
} ;
|
||||||
} : _ Operation.t)
|
} : _ Operation.t)
|
||||||
|
|
||||||
let endorsement ?delegate ?level ctxt =
|
let endorsement ?delegate ?level ctxt ?(signing_context = ctxt) () =
|
||||||
fun ?(signing_context=ctxt) slots ->
|
begin
|
||||||
begin
|
match delegate with
|
||||||
match delegate with
|
| None ->
|
||||||
| None -> Context.get_endorser ctxt (List.hd slots)
|
Context.get_endorser ctxt >>=? fun (delegate, _slots) ->
|
||||||
| Some delegate -> return delegate
|
return delegate
|
||||||
end >>=? fun delegate_pkh ->
|
| Some delegate -> return delegate
|
||||||
Account.find delegate_pkh >>=? fun delegate ->
|
end >>=? fun delegate_pkh ->
|
||||||
begin
|
Account.find delegate_pkh >>=? fun delegate ->
|
||||||
match level with
|
begin
|
||||||
| None -> Context.get_level ctxt
|
match level with
|
||||||
| Some level -> return level
|
| None -> Context.get_level ctxt
|
||||||
end >>=? fun level ->
|
| Some level -> return level
|
||||||
let op =
|
end >>=? fun level ->
|
||||||
Single
|
let op =
|
||||||
(Endorsements
|
Single
|
||||||
{ block = Context.branch ctxt ; level ; slots = slots }) in
|
(Endorsement
|
||||||
return (sign ~watermark:Signature.Endorsement delegate.sk signing_context op)
|
{ block = Context.branch ctxt ; level }) in
|
||||||
|
return (sign ~watermark:Signature.Endorsement delegate.sk signing_context op)
|
||||||
|
|
||||||
let sign ?watermark sk ctxt (Contents_list contents) =
|
let sign ?watermark sk ctxt (Contents_list contents) =
|
||||||
Operation.pack (sign ?watermark sk ctxt contents)
|
Operation.pack (sign ?watermark sk ctxt contents)
|
||||||
@ -137,15 +138,15 @@ let origination ?delegate ?script
|
|||||||
let op = sign account.sk ctxt sop in
|
let op = sign account.sk ctxt sop in
|
||||||
return (op , originated_contract op)
|
return (op , originated_contract op)
|
||||||
|
|
||||||
let miss_signed_endorsement ?level ctxt slot =
|
let miss_signed_endorsement ?level ctxt =
|
||||||
begin
|
begin
|
||||||
match level with
|
match level with
|
||||||
| None -> Context.get_level ctxt
|
| None -> Context.get_level ctxt
|
||||||
| Some level -> return level
|
| Some level -> return level
|
||||||
end >>=? fun level ->
|
end >>=? fun level ->
|
||||||
Context.get_endorser ctxt slot >>=? fun real_delegate_pkh ->
|
Context.get_endorser ctxt >>=? fun (real_delegate_pkh, _slots) ->
|
||||||
let delegate = Account.find_alternate real_delegate_pkh in
|
let delegate = Account.find_alternate real_delegate_pkh in
|
||||||
endorsement ~delegate:delegate.pkh ~level ctxt [slot]
|
endorsement ~delegate:delegate.pkh ~level ctxt ()
|
||||||
|
|
||||||
let transaction ?fee ?gas_limit ?storage_limit ?parameters ctxt
|
let transaction ?fee ?gas_limit ?storage_limit ?parameters ctxt
|
||||||
(src:Contract.t) (dst:Contract.t)
|
(src:Contract.t) (dst:Contract.t)
|
||||||
|
@ -13,12 +13,12 @@ open Alpha_context
|
|||||||
val endorsement:
|
val endorsement:
|
||||||
?delegate:public_key_hash ->
|
?delegate:public_key_hash ->
|
||||||
?level:Raw_level.t ->
|
?level:Raw_level.t ->
|
||||||
Context.t -> ?signing_context:Context.t ->
|
Context.t -> ?signing_context:Context.t -> unit ->
|
||||||
int list -> Kind.endorsements Operation.t tzresult Lwt.t
|
Kind.endorsement Operation.t tzresult Lwt.t
|
||||||
|
|
||||||
val miss_signed_endorsement:
|
val miss_signed_endorsement:
|
||||||
?level:Raw_level.t ->
|
?level:Raw_level.t ->
|
||||||
Context.t -> int -> Kind.endorsements Operation.t tzresult Lwt.t
|
Context.t -> Kind.endorsement Operation.t tzresult Lwt.t
|
||||||
|
|
||||||
val transaction:
|
val transaction:
|
||||||
?fee:Tez.tez ->
|
?fee:Tez.tez ->
|
||||||
@ -60,8 +60,8 @@ val originated_contract:
|
|||||||
|
|
||||||
val double_endorsement:
|
val double_endorsement:
|
||||||
Context.t ->
|
Context.t ->
|
||||||
Kind.endorsements Operation.t ->
|
Kind.endorsement Operation.t ->
|
||||||
Kind.endorsements Operation.t ->
|
Kind.endorsement Operation.t ->
|
||||||
Operation.packed tzresult Lwt.t
|
Operation.packed tzresult Lwt.t
|
||||||
|
|
||||||
val double_baking:
|
val double_baking:
|
||||||
|
@ -91,7 +91,7 @@ let regular () =
|
|||||||
transfer_and_check_balances b new_contract contract Tez.one_cent >>=? fun _ ->
|
transfer_and_check_balances b new_contract contract Tez.one_cent >>=? fun _ ->
|
||||||
|
|
||||||
(* Delegatable *)
|
(* Delegatable *)
|
||||||
Context.get_endorser (B b) 0 >>=? fun account ->
|
Context.get_endorser (B b) >>=? fun (account, _slots) ->
|
||||||
Op.delegation (B b) new_contract (Some account) >>=? fun operation ->
|
Op.delegation (B b) new_contract (Some account) >>=? fun operation ->
|
||||||
Block.bake ~operation b >>=? fun _ ->
|
Block.bake ~operation b >>=? fun _ ->
|
||||||
return ()
|
return ()
|
||||||
@ -123,7 +123,7 @@ let unspendable () =
|
|||||||
|
|
||||||
let undelegatable fee () =
|
let undelegatable fee () =
|
||||||
register_origination ~delegatable:false () >>=? fun (b, _, new_contract) ->
|
register_origination ~delegatable:false () >>=? fun (b, _, new_contract) ->
|
||||||
Context.get_endorser (B b) 0 >>=? fun account ->
|
Context.get_endorser (B b) >>=? fun (account, _slots) ->
|
||||||
Incremental.begin_construction b >>=? fun i ->
|
Incremental.begin_construction b >>=? fun i ->
|
||||||
Context.Contract.balance (I i) new_contract >>=? fun balance ->
|
Context.Contract.balance (I i) new_contract >>=? fun balance ->
|
||||||
(* FIXME need Context.Contract.delegate: cf. delegation tests
|
(* FIXME need Context.Contract.delegate: cf. delegation tests
|
||||||
@ -233,22 +233,22 @@ let not_tez_in_contract_to_pay_fee () =
|
|||||||
(* change the manager/delegate of this account to the account
|
(* change the manager/delegate of this account to the account
|
||||||
of endorser *)
|
of endorser *)
|
||||||
|
|
||||||
let register_contract_get_ownership slot () =
|
let register_contract_get_ownership () =
|
||||||
Context.init 1 >>=? fun (b, contracts) ->
|
Context.init 1 >>=? fun (b, contracts) ->
|
||||||
let contract = List.hd contracts in
|
let contract = List.hd contracts in
|
||||||
Incremental.begin_construction b >>=? fun inc ->
|
Incremental.begin_construction b >>=? fun inc ->
|
||||||
Context.get_endorser (I inc) slot >>=? fun account_endorser ->
|
Context.get_endorser (I inc) >>=? fun (account_endorser, _slots) ->
|
||||||
return (inc, contract, account_endorser)
|
return (inc, contract, account_endorser)
|
||||||
|
|
||||||
let change_manager () =
|
let change_manager () =
|
||||||
register_contract_get_ownership 0 () >>=? fun (inc, contract, account_endorser) ->
|
register_contract_get_ownership () >>=? fun (inc, contract, account_endorser) ->
|
||||||
Op.origination ~manager:account_endorser (I inc) ~credit:Tez.one contract >>=? fun (op, _) ->
|
Op.origination ~manager:account_endorser (I inc) ~credit:Tez.one contract >>=? fun (op, _) ->
|
||||||
Incremental.add_operation inc op >>=? fun inc ->
|
Incremental.add_operation inc op >>=? fun inc ->
|
||||||
Incremental.finalize_block inc >>=? fun _ ->
|
Incremental.finalize_block inc >>=? fun _ ->
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
let change_delegate () =
|
let change_delegate () =
|
||||||
register_contract_get_ownership 0 () >>=? fun (inc, contract, account_endorser) ->
|
register_contract_get_ownership () >>=? fun (inc, contract, account_endorser) ->
|
||||||
Op.origination ~delegate:account_endorser (I inc) ~credit:Tez.one contract >>=? fun (op, _) ->
|
Op.origination ~delegate:account_endorser (I inc) ~credit:Tez.one contract >>=? fun (op, _) ->
|
||||||
Incremental.add_operation inc op >>=? fun inc ->
|
Incremental.add_operation inc op >>=? fun inc ->
|
||||||
Incremental.finalize_block inc >>=? fun _ ->
|
Incremental.finalize_block inc >>=? fun _ ->
|
||||||
|
Loading…
Reference in New Issue
Block a user