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

Alpha: remove slots from endorsements

Browse Source
This commit is contained in:
Grégoire Henry 2018-05-06 02:08:39 +02:00
parent 41707f58d8
commit 1ab9a7a72c
30 changed files with 302 additions and 631 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
.gitlab-ci.yml
View File

@ -187,10 +187,10 @@ test:p2p:banned_peers:
# script:
# - jbuilder build @src/proto_alpha/lib_delegate/runtest_origination
test:client_alpha:endorsement:
<<: *test_definition
script:
- jbuilder build @src/proto_alpha/lib_delegate/runtest_endorsement
# test:client_alpha:endorsement:
# <<: *test_definition
# script:
# - jbuilder build @src/proto_alpha/lib_baking/runtest_endorsement
test:client_alpha:vote:
<<: *test_definition

2
src/proto_alpha/lib_client/injection.ml
View File

@ -42,7 +42,7 @@ let preapply (type t)
({ branch }, Contents_list contents) in
let watermark =
match contents with
| Single (Endorsements _) -> Signature.Endorsement
| Single (Endorsement _) -> Signature.Endorsement
| _ -> Signature.Generic_operation in
begin
match src_sk with

4
src/proto_alpha/lib_client/operation_result.ml
View File

@ -300,8 +300,8 @@ let rec pp_contents_and_result_list :
Ed25519.Public_key_hash.pp id
pp_balance_updates bus
| Single_and_result
(Endorsements { block ; level ; slots },
Endorsements_result (delegate, _slots)) ->
(Endorsement { block ; level },
Endorsement_result (delegate, slots)) ->
Format.fprintf ppf
"@[<v 2>Endorsement:@,\
Block: %a@,\

14
src/proto_alpha/lib_delegate/client_baking_endorsement.ml
View File

@ -25,13 +25,11 @@ let get_signing_slots cctxt ?(chain = `Main) block delegate level =
let inject_endorsement
(cctxt : #Proto_alpha.full)
?(chain = `Main) block hash level ?async
src_sk slots pkh =
src_sk pkh =
Alpha_services.Forge.endorsement cctxt
(chain, block)
~branch:hash
~block:hash
~level:level
~slots
() >>=? fun bytes ->
Client_keys.append cctxt
src_sk ~watermark:Endorsement bytes >>=? fun signed_bytes ->
@ -77,13 +75,15 @@ let forge_endorsement (cctxt : #Proto_alpha.full)
| Some slots -> return slots
end >>=? fun slots ->
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) ->
cctxt#message
"Injected endorsement level %a, contract %s '%a'"
"Injected endorsement level %a, contract %s '%a', slots @[<h>%a@]"
Raw_level.pp level
name
Operation_hash.pp_short oph >>=
Operation_hash.pp_short oph
(Format.pp_print_list Format.pp_print_int) slots
>>=
fun () -> return oph
(** Worker *)
@ -124,7 +124,7 @@ let endorse_for_delegate cctxt { delegate ; block ; slots ; } =
(List.length slots) >>= fun () ->
inject_endorsement cctxt
b hash level
sk slots delegate >>=? fun oph ->
sk delegate >>=? fun oph ->
lwt_log_info
"Injected endorsement for block '%a' \
(level %a, contract %s) '%a'"

14
src/proto_alpha/lib_delegate/test/jbuild
View File

@ -1,8 +1,7 @@
(jbuild_version 1)
(executables
((names (test_endorsement
test_michelson_parser
((names (test_michelson_parser
test_origination
test_transaction
test_rpc
@ -29,18 +28,12 @@
(alias
((name buildtest)
(deps (test_endorsement.exe
test_michelson_parser.exe
(deps (test_michelson_parser.exe
;test_origination.exe
;test_transaction.exe
test_rpc.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
((name runtest_michelson_parser)
(action (run ${exe:test_michelson_parser.exe}))))
@ -67,8 +60,7 @@
(alias
((name runtest)
(deps ((alias runtest_endorsement)
(alias runtest_michelson_parser)
(deps ((alias runtest_michelson_parser)
;(alias runtest_origination)
;(alias runtest_transaction)
(alias runtest_rpc)

22
src/proto_alpha/lib_delegate/test/proto_alpha_helpers.ml
View File

@ -547,14 +547,14 @@ module Endorse = struct
let forge_endorsement
block
src_sk
slot =
=
Shell_services.Blocks.hash !rpc_ctxt ~block () >>=? fun hash ->
Alpha_block_services.metadata
!rpc_ctxt ~chain:`Main ~block () >>=? fun { protocol_data = { level } } ->
let level = level.level in
let shell = { Tezos_base.Operation.branch = hash } in
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)
let signing_slots
@ -568,25 +568,9 @@ module Endorse = struct
| _ -> return []
let endorse
?slot
(contract : Account.t)
block =
Alpha_block_services.metadata
!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
forge_endorsement block contract.sk
(* FIXME @vb: I don't understand this function, copied from @cago. *)
let endorsers_list block =

1
src/proto_alpha/lib_delegate/test/proto_alpha_helpers.mli
View File

@ -112,7 +112,6 @@ end
module Endorse : sig
val endorse :
?slot:int ->
Account.t ->
Block_services.block ->
Operation.packed tzresult Lwt.t

270
src/proto_alpha/lib_delegate/test/test_endorsement.ml
View File

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

3
src/proto_alpha/lib_protocol/src/alpha_context.ml
View File

@ -137,8 +137,9 @@ let finalize ?commit_message:message c =
let activate = Raw_context.activate
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 allowed_endorsements = Raw_context.allowed_endorsements
let init_endorsements = Raw_context.init_endorsements
let reset_internal_nonce = Raw_context.reset_internal_nonce
let fresh_internal_nonce = Raw_context.fresh_internal_nonce

25
src/proto_alpha/lib_protocol/src/alpha_context.mli
View File

@ -772,7 +772,7 @@ module Kind : sig
type double_endorsement_evidence = Double_endorsement_evidence_kind
type double_baking_evidence = Double_baking_evidence_kind
type activate_account = Activate_account_kind
type endorsements = Endorsements_kind
type endorsement = Endorsement_kind
type proposals = Proposals_kind
type ballot = Ballot_kind
type reveal = Reveal_kind
@ -802,18 +802,17 @@ and _ contents_list =
(('kind * 'rest) Kind.manager ) contents_list
and _ contents =
| Endorsements : {
| Endorsement : {
block: Block_hash.t ;
level: Raw_level.t ;
slots: int list ;
} -> Kind.endorsements contents
} -> Kind.endorsement contents
| Seed_nonce_revelation : {
level: Raw_level.t ;
nonce: Nonce.t ;
} -> Kind.seed_nonce_revelation contents
| Double_endorsement_evidence : {
op1: Kind.endorsements operation ;
op2: Kind.endorsements operation ;
op1: Kind.endorsement operation ;
op2: Kind.endorsement operation ;
} -> Kind.double_endorsement_evidence contents
| Double_baking_evidence : {
bh1: Block_header.t ;
@ -929,6 +928,7 @@ module Operation : sig
type error += Invalid_signature (* `Permanent *)
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
@ -947,7 +947,7 @@ module Operation : sig
proj: 'b contents -> 'a ;
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 double_endorsement_evidence_case: Kind.double_endorsement_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 fork_test_chain: context -> Protocol_hash.t -> Time.t -> context Lwt.t
val endorsement_already_recorded: context -> int -> bool
val record_endorsement: context -> int -> context
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
val reset_internal_nonce: context -> context
val fresh_internal_nonce: context -> (context * int) tzresult

83
src/proto_alpha/lib_protocol/src/apply.ml
View File

@ -13,7 +13,6 @@ open Alpha_context
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 += Duplicate_endorsement of int (* `Branch *)
type error += Invalid_endorsement_level
type error += Invalid_commitment of { expected: bool }
type error += Internal_operation_replay of packed_internal_operation
@ -71,16 +70,6 @@ let () =
(req "provided" Voting_period.encoding))
(function Wrong_voting_period (e, p) -> Some (e, p) | _ -> None)
(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
`Temporary
~id:"operation.invalid_endorsement_level"
@ -602,30 +591,21 @@ let rec apply_manager_contents_list
Lwt.return (ctxt, Cons_result (result, mark_skipped rest))
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 =
match contents_list with
| Single (Endorsements { block ; level ; slots }) ->
begin
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) ->
| Single (Endorsement { block ; level }) ->
let current_level = (Level.current ctxt).level in
fail_unless
(Block_hash.equal block pred_block)
(Wrong_endorsement_predecessor (pred_block, block)) >>=? fun () ->
fail_unless
Raw_level.(level = current_level)
Raw_level.(succ level = current_level)
Invalid_endorsement_level >>=? fun () ->
fold_left_s (fun ctxt slot ->
fail_when
(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
Baking.check_endorsement_rights ctxt operation >>=? fun (delegate, slots) ->
let ctxt = record_endorsement ctxt delegate in
let gap = List.length slots in
let ctxt = Fitness.increase ~gap ctxt in
Lwt.return
@ -635,7 +615,7 @@ let apply_contents_list
Global.get_last_block_priority ctxt >>=? fun block_priority ->
Baking.endorsement_reward ctxt ~block_priority gap >>=? fun reward ->
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 }) ->
let level = Level.from_raw ctxt level in
Nonce.reveal ctxt level nonce >>=? fun ctxt ->
@ -645,8 +625,8 @@ let apply_contents_list
return (ctxt, Single_result (Seed_nonce_revelation_result [(* FIXME *)]))
| Single (Double_endorsement_evidence { op1 ; op2 }) -> begin
match op1.protocol_data.contents, op2.protocol_data.contents with
| Single (Endorsements e1),
Single (Endorsements e2)
| Single (Endorsement e1),
Single (Endorsement e2)
when Raw_level.(e1.level = e2.level) &&
not (Block_hash.equal e1.block e2.block) ->
let level = Level.from_raw ctxt e1.level in
@ -659,23 +639,15 @@ let apply_contents_list
(Outdated_double_endorsement_evidence
{ level = level.level ;
last = oldest_level }) >>=? fun () ->
(* Whenever a delegate might have multiple endorsement slots for
given level, she should not endorse different block with different
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 () ->
Baking.check_endorsement_rights ctxt op1 >>=? fun (delegate1, _) ->
Baking.check_endorsement_rights ctxt op2 >>=? fun (delegate2, _) ->
fail_unless
(Signature.Public_key.equal delegate1 delegate2)
(Signature.Public_key_hash.equal delegate1 delegate2)
(Inconsistent_double_endorsement_evidence
{ delegate1 = Signature.Public_key.hash delegate1 ;
delegate2 = Signature.Public_key.hash delegate2 }) >>=? fun () ->
let delegate = Signature.Public_key.hash delegate1 in
Delegate.has_frozen_balance ctxt delegate level.cycle >>=? fun valid ->
{ delegate1 ; delegate2 }) >>=? fun () ->
Delegate.has_frozen_balance ctxt delegate1 level.cycle >>=? fun valid ->
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 =
match Tez.(burned /? 2L) with
| Ok v -> v
@ -799,11 +771,21 @@ let begin_full_construction ctxt pred_timestamp protocol_data =
Baking.check_baking_rights
ctxt protocol_data pred_timestamp >>=? fun delegate_pk ->
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 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 current_level = Alpha_context.Level.current ctxt in
@ -821,7 +803,12 @@ let begin_application ctxt block_header pred_timestamp =
(Invalid_commitment
{ expected = current_level.expected_commitment }) >>=? fun () ->
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 deposit = Constants.block_security_deposit ctxt in

18
src/proto_alpha/lib_protocol/src/apply_operation_result.ml
View File

@ -334,8 +334,8 @@ let internal_operation_result_encoding :
]
type 'kind contents_result =
| Endorsements_result :
Signature.Public_key_hash.t * int list -> Kind.endorsements contents_result
| Endorsement_result :
Signature.Public_key_hash.t * int list -> Kind.endorsement contents_result
| Seed_nonce_revelation_result :
balance_updates -> Kind.seed_nonce_revelation contents_result
| Double_endorsement_evidence_result :
@ -389,17 +389,17 @@ module Encoding = struct
(req "slots" (list uint8))) ;
select =
(function
| Contents_result (Endorsements_result _ as op) -> Some op
| Contents_result (Endorsement_result _ as op) -> Some op
| _ -> None) ;
mselect =
(function
| Contents_and_result (Endorsements _ as op, res) -> Some (op, res)
| Contents_and_result (Endorsement _ as op, res) -> Some (op, res)
| _ -> None) ;
proj =
(function
| Endorsements_result (d, s) -> (d, s)) ;
| Endorsement_result (d, s) -> (d, s)) ;
inj =
(fun (d, s) -> Endorsements_result (d, s))
(fun (d, s) -> Endorsement_result (d, s))
}
let seed_nonce_revelation_case =
@ -543,7 +543,7 @@ module Encoding = struct
Some (Manager_operation_result
{ op with operation_result = Failed (res_case.kind, errs) })
| Contents_result Ballot_result -> None
| Contents_result (Endorsements_result _) -> None
| Contents_result (Endorsement_result _) -> None
| Contents_result (Seed_nonce_revelation_result _) -> None
| Contents_result (Double_endorsement_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 =
fun op res ->
match op, res with
| Endorsements _, Endorsements_result _ -> Some Eq
| Endorsements _, _ -> None
| Endorsement _, Endorsement_result _ -> Some Eq
| Endorsement _, _ -> None
| Seed_nonce_revelation _, Seed_nonce_revelation_result _ -> Some Eq
| Seed_nonce_revelation _, _ -> None
| Double_endorsement_evidence _, Double_endorsement_evidence_result _ -> Some Eq

4
src/proto_alpha/lib_protocol/src/apply_operation_result.mli
View File

@ -53,8 +53,8 @@ and packed_contents_result_list =
(** Result of applying an {!Operation.contents}. Follows the same structure. *)
and 'kind contents_result =
| Endorsements_result :
Signature.Public_key_hash.t * int list -> Kind.endorsements contents_result
| Endorsement_result :
Signature.Public_key_hash.t * int list -> Kind.endorsement contents_result
| Seed_nonce_revelation_result :
balance_updates -> Kind.seed_nonce_revelation contents_result
| Double_endorsement_evidence_result :

105
src/proto_alpha/lib_protocol/src/baking.ml
View File

@ -12,10 +12,8 @@ open Alpha_context
open Misc
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 += Inconsistent_endorsement of public_key_hash list (* `Permanent *)
type error += Empty_endorsement
type error += Unexpected_endorsement
type error += Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t (* `Permanent *)
type error += Invalid_signature (* `Permanent *)
type error += Invalid_stamp (* `Permanent *)
@ -48,32 +46,6 @@ let () =
(req "provided" int64))
(function Invalid_fitness_gap (m, g) -> Some (m, g) | _ -> None)
(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
`Permanent
~id:"baking.invalid_block_signature"
@ -108,8 +80,18 @@ let () =
Format.fprintf ppf "Insufficient proof-of-work stamp")
Data_encoding.empty
(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 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 () ->
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
let endorsement_reward ctxt ~block_priority:prio n =
@ -184,12 +153,41 @@ let baking_priorities c level =
in
f 0
let endorsement_priorities c level =
let rec f slot =
Roll.endorsement_rights_owner c level ~slot >>=? fun delegate ->
return (LCons (delegate, (fun () -> f (succ slot))))
in
f 0
let endorsement_rights c level =
fold_left_s
(fun acc slot ->
Roll.endorsement_rights_owner c level ~slot >>=? fun pk ->
let pkh = Signature.Public_key.hash pk in
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 rec loop acc l n =
@ -213,13 +211,6 @@ let first_baking_priorities
baking_priorities ctxt level >>=? fun delegate_list ->
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 bytes = Block_hash.to_bytes hash in
let word = MBytes.get_int64 bytes 0 in

24
src/proto_alpha/lib_protocol/src/baking.mli
View File

@ -12,10 +12,9 @@ open Alpha_context
open Misc
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 += 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 += Unexpected_endorsement
(** [minimal_time ctxt priority pred_block_time] returns the minimal
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 correspond to the same delegate at the current level;
*)
val check_endorsements_rights:
context -> Level.t -> int list -> public_key tzresult Lwt.t
val check_endorsement_rights:
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. *)
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:
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]
is a list of priorities of max [?max_priority] elements, where the
delegate of [contract_hash] is allowed to bake for [level]. If
@ -64,12 +64,6 @@ val first_baking_priorities:
Level.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
the given key *)
val check_signature: Block_header.t -> public_key -> unit tzresult Lwt.t

26
src/proto_alpha/lib_protocol/src/delegate_services.ml
View File

@ -480,25 +480,13 @@ module Endorsing_rights = struct
end
let endorsement_slots ctxt (level, estimated_time) =
let max_slot = Constants.endorsers_per_block ctxt in
Baking.endorsement_priorities ctxt level >>=? fun contract_list ->
let build (delegate, slots) = {
level = level.level ; delegate ; slots ; estimated_time
} in
let rec loop l map slot =
if Compare.Int.(slot >= max_slot) then
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
Baking.endorsement_rights ctxt level >>=? fun rights ->
return
(Signature.Public_key_hash.Map.fold
(fun delegate (_, slots) acc -> {
level = level.level ; delegate ; slots ; estimated_time
} :: acc)
rights [])
let register () =
let open Services_registration in

4
src/proto_alpha/lib_protocol/src/helpers_services.ml
View File

@ -390,9 +390,9 @@ module Forge = struct
() ({ branch }, Contents_list (Single operation))
let endorsement ctxt
b ~branch ~block ~level ~slots () =
b ~branch ~block ~level () =
operation ctxt b ~branch
(Endorsements { block ; level ; slots })
(Endorsement { block ; level })
let proposals ctxt
b ~branch ~source ~period ~proposals () =

1
src/proto_alpha/lib_protocol/src/helpers_services.mli
View File

@ -131,7 +131,6 @@ module Forge : sig
branch:Block_hash.t ->
block:Block_hash.t ->
level:Raw_level.t ->
slots:int list ->
unit -> MBytes.t shell_tzresult Lwt.t
val proposals:

6
src/proto_alpha/lib_protocol/src/main.ml
View File

@ -215,9 +215,9 @@ let compare_operations op1 op2 =
let Operation_data op1 = op1.protocol_data in
let Operation_data op2 = op2.protocol_data in
match op1.contents, op2.contents with
| Single (Endorsements _), Single (Endorsements _) -> 0
| _, Single (Endorsements _) -> 1
| Single (Endorsements _), _ -> -1
| Single (Endorsement _), Single (Endorsement _) -> 0
| _, Single (Endorsement _) -> 1
| Single (Endorsement _), _ -> -1
| Single (Seed_nonce_revelation _), Single (Seed_nonce_revelation _) -> 0
| _, Single (Seed_nonce_revelation _) -> 1

49
src/proto_alpha/lib_protocol/src/operation_repr.ml
View File

@ -14,7 +14,7 @@ module Kind = struct
type double_endorsement_evidence = Double_endorsement_evidence_kind
type double_baking_evidence = Double_baking_evidence_kind
type activate_account = Activate_account_kind
type endorsements = Endorsements_kind
type endorsement = Endorsement_kind
type proposals = Proposals_kind
type ballot = Ballot_kind
type reveal = Reveal_kind
@ -51,18 +51,17 @@ and _ contents_list =
(('kind * 'rest) Kind.manager ) contents_list
and _ contents =
| Endorsements : {
| Endorsement : {
block: Block_hash.t ;
level: Raw_level_repr.t ;
slots: int list ;
} -> Kind.endorsements contents
} -> Kind.endorsement contents
| Seed_nonce_revelation : {
level: Raw_level_repr.t ;
nonce: Seed_repr.nonce ;
} -> Kind.seed_nonce_revelation contents
| Double_endorsement_evidence : {
op1: Kind.endorsements operation ;
op2: Kind.endorsements operation ;
op1: Kind.endorsement operation ;
op2: Kind.endorsement operation ;
} -> Kind.double_endorsement_evidence contents
| Double_baking_evidence : {
bh1: Block_header_repr.t ;
@ -305,25 +304,24 @@ module Encoding = struct
proj: 'b contents -> 'a ;
inj: 'a -> 'b contents } -> 'b case
let endorsements_encoding =
obj3
let endorsement_encoding =
obj2
(req "block" Block_hash.encoding)
(req "level" Raw_level_repr.encoding)
(req "slots" (list int31))
let endorsement_case =
Case {
tag = 0 ;
name = "endorsement" ;
encoding = endorsements_encoding ;
encoding = endorsement_encoding ;
select =
(function
| Contents (Endorsements _ as op) -> Some op
| Contents (Endorsement _ as op) -> Some op
| _ -> None) ;
proj =
(fun (Endorsements { block ; level ; slots }) -> (block, level, slots)) ;
(fun (Endorsement { block ; level }) -> (block, level)) ;
inj =
(fun (block, level, slots) -> Endorsements { block ; level ; slots })
(fun (block, level) -> Endorsement { block ; level })
}
let endorsement_encoding =
@ -331,9 +329,9 @@ module Encoding = struct
case (Tag tag) name encoding
(fun o -> Some (proj o))
(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
let of_list : Kind.endorsements contents -> _ = function
let of_list : Kind.endorsement contents -> _ = function
| o -> Single o in
def "inlined.endorsement" @@
conv
@ -608,7 +606,7 @@ let acceptable_passes (op : packed_operation) =
let Operation_data protocol_data = op.protocol_data in
match protocol_data.contents with
| Single (Endorsements _) -> [0]
| Single (Endorsement _) -> [0]
| Single (Proposals _ ) -> [1]
| Single (Ballot _ ) -> [1]
@ -648,27 +646,30 @@ let () =
(function Missing_signature -> Some () | _ -> None)
(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 unsigned_operation =
Data_encoding.Binary.to_bytes_exn
unsigned_operation_encoding (shell, contents) in
if Signature.check ~watermark key signature unsigned_operation then
return ()
Ok ()
else
fail Invalid_signature in
Error [Invalid_signature] in
match protocol_data.contents, protocol_data.signature with
| Single _, None ->
fail Missing_signature
Error [Missing_signature]
| Cons _, None ->
fail Missing_signature
| Single (Endorsements _) as contents, Some signature ->
Error [Missing_signature]
| Single (Endorsement _) as contents, Some signature ->
check ~watermark:Endorsement (Contents_list contents) signature
| Single _ as contents, Some signature ->
check ~watermark:Generic_operation (Contents_list contents) signature
| Cons _ as contents, Some 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 (o : _ operation) =
let proto =
@ -702,8 +703,8 @@ let equal_contents_kind
: type a b. a contents -> b contents -> (a, b) eq option
= fun op1 op2 ->
match op1, op2 with
| Endorsements _, Endorsements _ -> Some Eq
| Endorsements _, _ -> None
| Endorsement _, Endorsement _ -> Some Eq
| Endorsement _, _ -> None
| Seed_nonce_revelation _, Seed_nonce_revelation _ -> Some Eq
| Seed_nonce_revelation _, _ -> None
| Double_endorsement_evidence _, Double_endorsement_evidence _ -> Some Eq

16
src/proto_alpha/lib_protocol/src/operation_repr.mli
View File

@ -14,7 +14,7 @@ module Kind : sig
type double_endorsement_evidence = Double_endorsement_evidence_kind
type double_baking_evidence = Double_baking_evidence_kind
type activate_account = Activate_account_kind
type endorsements = Endorsements_kind
type endorsement = Endorsement_kind
type proposals = Proposals_kind
type ballot = Ballot_kind
type reveal = Reveal_kind
@ -52,18 +52,17 @@ and _ contents_list =
(('kind * 'rest) Kind.manager ) contents_list
and _ contents =
| Endorsements : {
| Endorsement : {
block: Block_hash.t ;
level: Raw_level_repr.t ;
slots: int list ;
} -> Kind.endorsements contents
} -> Kind.endorsement contents
| Seed_nonce_revelation : {
level: Raw_level_repr.t ;
nonce: Seed_repr.nonce ;
} -> Kind.seed_nonce_revelation contents
| Double_endorsement_evidence : {
op1: Kind.endorsements operation ;
op2: Kind.endorsements operation ;
op1: Kind.endorsement operation ;
op2: Kind.endorsement operation ;
} -> Kind.double_endorsement_evidence contents
| Double_baking_evidence : {
bh1: Block_header_repr.t ;
@ -166,6 +165,9 @@ type error += Invalid_signature (* `Permanent *)
val check_signature:
Signature.Public_key.t -> _ operation -> unit tzresult Lwt.t
val raw_check_signature:
Signature.Public_key.t -> _ operation -> unit tzresult
val internal_operation_encoding:
packed_internal_operation Data_encoding.t
@ -183,7 +185,7 @@ module Encoding : sig
proj: 'b contents -> 'a ;
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 double_endorsement_evidence_case: Kind.double_endorsement_evidence case
val double_baking_evidence_case: Kind.double_baking_evidence case

17
src/proto_alpha/lib_protocol/src/raw_context.ml
View File

@ -16,8 +16,9 @@ type t = {
level: Level_repr.t ;
timestamp: Time.t ;
fitness: Int64.t ;
endorsements_received: Int_set.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 ;
rewards: Tez_repr.t ;
block_gas: Z.t ;
@ -39,8 +40,14 @@ let first_level ctxt = ctxt.first_level
let constants ctxt = ctxt.constants
let recover ctxt = ctxt.context
let record_endorsement ctxt k = { ctxt with endorsements_received = Int_set.add k ctxt.endorsements_received }
let endorsement_already_recorded ctxt k = Int_set.mem k ctxt.endorsements_received
let record_endorsement ctxt k =
{ 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 *)
@ -402,7 +409,7 @@ let prepare ~level ~timestamp ~fitness ctxt =
return {
context = ctxt ; constants ; level ;
timestamp ; fitness ; first_level ;
endorsements_received = Int_set.empty ;
allowed_endorsements = Signature.Public_key_hash.Map.empty ;
fees = Tez_repr.zero ;
rewards = Tez_repr.zero ;
deposits = Signature.Public_key_hash.Map.empty ;
@ -454,7 +461,7 @@ let register_resolvers enc resolve =
level = Level_repr.root Raw_level_repr.root ;
timestamp = Time.of_seconds 0L ;
fitness = 0L ;
endorsements_received = Int_set.empty ;
allowed_endorsements = Signature.Public_key_hash.Map.empty ;
fees = Tez_repr.zero ;
rewards = Tez_repr.zero ;
deposits = Signature.Public_key_hash.Map.empty ;

13
src/proto_alpha/lib_protocol/src/raw_context.mli
View File

@ -192,9 +192,6 @@ end
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
duplicate an internal operation to replay it. *)
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. *)
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

38
src/proto_alpha/lib_protocol/test/double_endorsement.ml
View File

@ -52,9 +52,9 @@ let valid_double_endorsement_evidence () =
block_fork b >>=? fun (blk_a, blk_b) ->
Context.get_endorser (B blk_a) 0 >>=? fun delegate ->
Op.endorsement ~delegate (B blk_a) [0] >>=? fun endorsement_a ->
Op.endorsement ~delegate (B blk_b) [0] >>=? fun endorsement_b ->
Context.get_endorser (B blk_a) >>=? fun (delegate, _slots) ->
Op.endorsement ~delegate (B blk_a) () >>=? fun endorsement_a ->
Op.endorsement ~delegate (B blk_b) () >>=? fun endorsement_b ->
Block.bake ~operations:[Operation.pack endorsement_a] blk_a >>=? fun blk_a ->
(* Block.bake ~operations:[endorsement_b] blk_b >>=? fun _ -> *)
@ -82,7 +82,7 @@ let invalid_double_endorsement () =
Context.init 10 >>=? 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 ->
Op.double_endorsement (B b) endorsement endorsement >>=? fun operation ->
@ -97,9 +97,9 @@ let too_early_double_endorsement_evidence () =
Context.init 2 >>=? fun (b, _) ->
block_fork b >>=? fun (blk_a, blk_b) ->
Context.get_endorser (B blk_a) 0 >>=? fun delegate ->
Op.endorsement ~delegate (B blk_a) [0] >>=? fun endorsement_a ->
Op.endorsement ~delegate (B blk_b) [0] >>=? fun endorsement_b ->
Context.get_endorser (B blk_a) >>=? fun (delegate, _) ->
Op.endorsement ~delegate (B blk_a) () >>=? fun endorsement_a ->
Op.endorsement ~delegate (B blk_b) () >>=? fun endorsement_b ->
Op.double_endorsement (B b) endorsement_a endorsement_b >>=? fun operation ->
Block.bake ~operation b >>= fun res ->
@ -116,9 +116,9 @@ let too_late_double_endorsement_evidence () =
block_fork b >>=? fun (blk_a, blk_b) ->
Context.get_endorser (B blk_a) 0 >>=? fun delegate ->
Op.endorsement ~delegate (B blk_a) [0] >>=? fun endorsement_a ->
Op.endorsement ~delegate (B blk_b) [0] >>=? fun endorsement_b ->
Context.get_endorser (B blk_a) >>=? fun (delegate, _slots) ->
Op.endorsement ~delegate (B blk_a) () >>=? fun endorsement_a ->
Op.endorsement ~delegate (B blk_b) () >>=? fun endorsement_b ->
fold_left_s (fun blk _ -> Block.bake_until_cycle_end blk)
blk_a (1 -- (preserved_cycles + 1)) >>=? fun blk ->
@ -134,12 +134,13 @@ let too_late_double_endorsement_evidence () =
let different_delegates () =
Context.init 2 >>=? fun (b, _) ->
block_fork b >>=? fun (blk_a, blk_b) ->
get_first_different_endorsers (B blk_a)
>>=? fun (endorser_a, endorser_b) ->
Block.bake b >>=? fun b ->
Block.bake b >>=? fun blk_a ->
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_b.delegate (B blk_b) endorser_b.slots >>=? fun e_b ->
Op.endorsement ~delegate:endorser_a.delegate (B blk_a) () >>=? fun e_a ->
Op.endorsement ~delegate:endorser_b.delegate (B blk_b) () >>=? fun e_b ->
Op.double_endorsement (B blk_a) e_a e_b >>=? fun operation ->
Block.bake ~operation blk_a >>= fun res ->
Assert.proto_error ~loc:__LOC__ res begin function
@ -153,10 +154,10 @@ let wrong_delegate () =
block_fork b >>=? fun (blk_a, blk_b) ->
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_b) endorser_b.slots >>=? fun endorsement_b ->
Op.endorsement ~delegate:endorser_b.delegate (B blk_a) () >>=? fun endorsement_a ->
Op.endorsement ~delegate:endorser_b.delegate (B blk_b) () >>=? fun endorsement_b ->
Op.double_endorsement (B blk_a) endorsement_a endorsement_b >>=? fun operation ->
Block.bake ~operation blk_a >>= fun e ->
@ -173,3 +174,4 @@ let tests = [
Test.tztest "different delegates" `Quick different_delegates ;
Test.tztest "wrong delegate" `Quick wrong_delegate ;
]

88
src/proto_alpha/lib_protocol/test/endorsement.ml
View File

@ -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 *)
let simple_endorsement () =
Context.init 5 >>=? fun (b, _) ->
let slot = 1 in
Context.get_endorser (B b) slot >>=? fun endorser ->
Op.endorsement ~delegate:endorser (B b) [slot] >>=? fun op ->
Context.get_endorser (B b) >>=? fun (delegate, slots) ->
Op.endorsement ~delegate (B b) () >>=? fun op ->
Context.Contract.balance (B b)
(Contract.implicit_contract endorser) >>=? fun initial_balance ->
(Contract.implicit_contract delegate) >>=? fun initial_balance ->
Block.bake
~policy:(Excluding [endorser])
~policy:(Excluding [delegate])
~operations:[Operation.pack op]
b >>=? fun b2 ->
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
twice. *)
@ -86,7 +86,7 @@ let max_endorsement () =
fold_left_s (fun (delegates, ops, balances) (endorser : Alpha_services.Delegate.Endorsing_rights.t) ->
let delegate = endorser.delegate in
Context.Contract.balance (B b) (Contract.implicit_contract delegate) >>=? fun balance ->
Op.endorsement ~delegate (B b) endorser.slots >>=? fun op ->
Op.endorsement ~delegate (B b) () >>=? fun op ->
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 ->
(* Grab an endorser that didn't bake the previous block *)
Context.get_endorser (B b) 0 >>=? fun endorser_0 ->
Context.get_endorser (B b) 1 >>=? fun endorser_1 ->
let (endorser, slot) =
if endorser_0 = baker_account then endorser_1, 1 else endorser_0, 0
in
Context.Contract.balance (B b) (Contract.implicit_contract endorser) >>=? fun balance ->
Context.get_endorsers (B b) >>=? fun endorsers ->
let endorser =
List.find
(fun e -> e.Delegate_services.Endorsing_rights.delegate <> baker_account)
endorsers in
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
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
(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 *)
let consistent_priorities () =
@ -133,19 +133,19 @@ let consistent_priorities () =
Block.bake ~policy:(By_priority priority) b >>=? fun b ->
(* Grab an endorser that didn't bake the previous block *)
Context.get_endorser (B b) 0 >>=? fun endorser_0 ->
Context.get_endorser (B b) 1 >>=? fun endorser_1 ->
let (endorser, slot) =
if endorser_0 = baker_account then endorser_1, 1 else endorser_0, 0
in
Context.get_endorsers (B b) >>=? fun endorsers ->
let endorser =
List.find
(fun e -> e.Delegate_services.Endorsing_rights.delegate <> baker_account)
endorsers in
Context.Contract.balance (B b) (Contract.implicit_contract endorser) >>=? fun balance ->
Op.endorsement ~delegate:endorser (B b) [slot] >>=? fun operation ->
Context.Contract.balance (B b) (Contract.implicit_contract endorser.delegate) >>=? fun balance ->
Op.endorsement ~delegate:endorser.delegate (B b) () >>=? fun operation ->
let operation = Operation.pack operation in
Block.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
(B b) ~nb_endorsement:1 endorser balance
(B b) ~nb_endorsement:(List.length endorser.slots) endorser.delegate balance
) priorities
(** Check that after a cycle the endorser gets his reward *)
@ -154,10 +154,9 @@ let reward_retrieval () =
Context.get_constants (B b) >>=? fun Constants.
{ parametric = { preserved_cycles ; endorsement_reward ; _ } ; _ } ->
let slot = 0 in
Context.get_endorser (B b) slot >>=? fun endorser ->
Context.get_endorser (B b) >>=? fun (endorser, slots) ->
Context.Contract.balance (B b) (Contract.implicit_contract endorser) >>=? fun balance ->
Op.endorsement ~delegate:endorser (B b) [slot] >>=? fun operation ->
Op.endorsement ~delegate:endorser (B b) () >>=? fun operation ->
let operation = Operation.pack operation in
Block.bake ~policy:(Excluding [ endorser ]) ~operation b >>=? fun b ->
(* Bake (preserved_cycles + 1) cycles *)
@ -165,7 +164,8 @@ let reward_retrieval () =
Block.bake_until_cycle_end ~policy:(Excluding [ endorser ]) 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. *)
@ -176,9 +176,9 @@ let reward_retrieval () =
let wrong_endorsement_predecessor () =
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' ->
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
Block.bake ~operation b' >>= fun res ->
@ -193,7 +193,7 @@ let invalid_endorsement_level () =
Context.init 5 >>=? fun (b, _) ->
Context.get_level (B b) >>=? fun genesis_level ->
Block.bake b >>=? fun b ->
Op.endorsement ~level:genesis_level (B b) [0] >>=? fun operation ->
Op.endorsement ~level:genesis_level (B b) () >>=? fun operation ->
let operation = Operation.pack operation in
Block.bake ~operation b >>= fun res ->
@ -206,31 +206,15 @@ let invalid_endorsement_level () =
let duplicate_endorsement () =
Context.init 5 >>=? fun (b, _) ->
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
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
Incremental.add_operation inc operation >>= fun res ->
Assert.proto_error ~loc:__LOC__ res begin function
| Apply.Duplicate_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
| Baking.Unexpected_endorsement -> true
| _ -> false
end
@ -276,7 +260,5 @@ let tests = [
Test.tztest "Wrong endorsement predecessor" `Quick wrong_endorsement_predecessor ;
Test.tztest "Invalid endorsement level" `Quick invalid_endorsement_level ;
Test.tztest "Duplicate endorsement" `Quick duplicate_endorsement ;
Test.tztest "Invalid endorsement slot" `Quick invalid_endorsement_slot ;
Test.tztest "Not enough for deposit" `Quick no_enough_for_deposit ;
]

11
src/proto_alpha/lib_protocol/test/helpers/context.ml
View File

@ -66,13 +66,10 @@ end
let get_endorsers ctxt =
Alpha_services.Delegate.Endorsing_rights.get rpc_ctxt ctxt
let get_endorser ctxt slot =
Alpha_services.Delegate.Endorsing_rights.get
rpc_ctxt ctxt >>=? fun endorsers ->
try return (List.find (fun {Alpha_services.Delegate.Endorsing_rights.slots} -> List.mem slot slots) endorsers).delegate
with _ ->
failwith "Failed to lookup endorsers for ctxt %a, slot %d."
Block_hash.pp_short (branch ctxt) slot
let get_endorser ctxt =
Alpha_services.Delegate.Endorsing_rights.get rpc_ctxt ctxt >>=? fun endorsers ->
let endorser = List.hd endorsers in
return (endorser.delegate, endorser.slots)
let get_bakers ctxt =
Alpha_services.Delegate.Baking_rights.get

2
src/proto_alpha/lib_protocol/test/helpers/context.mli
View File

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

43
src/proto_alpha/lib_protocol/test/helpers/op.ml
View File

@ -25,24 +25,25 @@ let sign ?(watermark = Signature.Generic_operation)
} ;
} : _ Operation.t)
let endorsement ?delegate ?level ctxt =
fun ?(signing_context=ctxt) slots ->
begin
match delegate with
| None -> Context.get_endorser ctxt (List.hd slots)
| Some delegate -> return delegate
end >>=? fun delegate_pkh ->
Account.find delegate_pkh >>=? fun delegate ->
begin
match level with
| None -> Context.get_level ctxt
| Some level -> return level
end >>=? fun level ->
let op =
Single
(Endorsements
{ block = Context.branch ctxt ; level ; slots = slots }) in
return (sign ~watermark:Signature.Endorsement delegate.sk signing_context op)
let endorsement ?delegate ?level ctxt ?(signing_context = ctxt) () =
begin
match delegate with
| None ->
Context.get_endorser ctxt >>=? fun (delegate, _slots) ->
return delegate
| Some delegate -> return delegate
end >>=? fun delegate_pkh ->
Account.find delegate_pkh >>=? fun delegate ->
begin
match level with
| None -> Context.get_level ctxt
| Some level -> return level
end >>=? fun level ->
let op =
Single
(Endorsement
{ block = Context.branch ctxt ; level }) in
return (sign ~watermark:Signature.Endorsement delegate.sk signing_context op)
let sign ?watermark sk ctxt (Contents_list contents) =
Operation.pack (sign ?watermark sk ctxt contents)
@ -137,15 +138,15 @@ let origination ?delegate ?script
let op = sign account.sk ctxt sop in
return (op , originated_contract op)
let miss_signed_endorsement ?level ctxt slot =
let miss_signed_endorsement ?level ctxt =
begin
match level with
| None -> Context.get_level ctxt
| Some level -> return level
end >>=? fun level ->
Context.get_endorser ctxt slot >>=? fun real_delegate_pkh ->
Context.get_endorser ctxt >>=? fun (real_delegate_pkh, _slots) ->
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
(src:Contract.t) (dst:Contract.t)

10
src/proto_alpha/lib_protocol/test/helpers/op.mli
View File

@ -13,12 +13,12 @@ open Alpha_context
val endorsement:
?delegate:public_key_hash ->
?level:Raw_level.t ->
Context.t -> ?signing_context:Context.t ->
int list -> Kind.endorsements Operation.t tzresult Lwt.t
Context.t -> ?signing_context:Context.t -> unit ->
Kind.endorsement Operation.t tzresult Lwt.t
val miss_signed_endorsement:
?level:Raw_level.t ->
Context.t -> int -> Kind.endorsements Operation.t tzresult Lwt.t
Context.t -> Kind.endorsement Operation.t tzresult Lwt.t
val transaction:
?fee:Tez.tez ->
@ -60,8 +60,8 @@ val originated_contract:
val double_endorsement:
Context.t ->
Kind.endorsements Operation.t ->
Kind.endorsements Operation.t ->
Kind.endorsement Operation.t ->
Kind.endorsement Operation.t ->
Operation.packed tzresult Lwt.t
val double_baking:

12
src/proto_alpha/lib_protocol/test/origination.ml
View File

@ -91,7 +91,7 @@ let regular () =
transfer_and_check_balances b new_contract contract Tez.one_cent >>=? fun _ ->
(* 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 ->
Block.bake ~operation b >>=? fun _ ->
return ()
@ -123,7 +123,7 @@ let unspendable () =
let undelegatable fee () =
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 ->
Context.Contract.balance (I i) new_contract >>=? fun balance ->
(* 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
of endorser *)
let register_contract_get_ownership slot () =
let register_contract_get_ownership () =
Context.init 1 >>=? fun (b, contracts) ->
let contract = List.hd contracts in
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)
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, _) ->
Incremental.add_operation inc op >>=? fun inc ->
Incremental.finalize_block inc >>=? fun _ ->
return ()
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, _) ->
Incremental.add_operation inc op >>=? fun inc ->
Incremental.finalize_block inc >>=? fun _ ->