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

Shell: Liveness of operations

Browse Source 
Operations now include a block hash in their header. Such an operation
could only be included in a successor of this block.

Furthermore, when validating a block, the economic protocol now
returns---together with the context---an integer `max_operations_ttl`.
Then, when validating a successor, the shell will fail if it contains
an operation whose header's block hash is not one the
`max_operations_ttl` predecessors of the block.

As a bonus, the shell is now able to detect and forbid replayed
operations. Then, we might decide to remove some replay
detection-mechanism that we previously implemented in the economic
protocol.
This commit is contained in:
Grégoire Henry 2017-04-20 08:49:14 +02:00
parent 329c8b185a
commit 2bc63854a8
22 changed files with 280 additions and 183 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/client/client_node_rpcs.mli
View File

@ -53,12 +53,7 @@ val inject_protocol:
module Blocks : sig module Blocks : sig
type block = [ type block = Node_rpc_services.Blocks.block
| `Genesis
| `Head of int | `Prevalidation
| `Test_head of int | `Test_prevalidation
| `Hash of Block_hash.t
]
val net_id: val net_id:
config -> config ->

1
src/client/embedded/alpha/baker/client_mining_endorsement.ml
View File

@ -124,6 +124,7 @@ let inject_endorsement cctxt
Client_proto_rpcs.Helpers.Forge.Delegate.endorsement cctxt.rpc_config Client_proto_rpcs.Helpers.Forge.Delegate.endorsement cctxt.rpc_config
block block
~net_id:bi.net_id ~net_id:bi.net_id
~branch:bi.hash
~source ~source
~block:bi.hash ~block:bi.hash
~slot:slot ~slot:slot

11
src/client/embedded/alpha/baker/client_mining_revelation.ml
View File

@ -11,15 +11,16 @@ open Cli_entries
open Tezos_context open Tezos_context
open Logging.Client.Revelation open Logging.Client.Revelation
let inject_seed_nonce_revelation cctxt block ?force ?async nonces = let inject_seed_nonce_revelation rpc_config block ?force ?async nonces =
let operations = let operations =
List.map List.map
(fun (level, nonce) -> (fun (level, nonce) ->
Seed_nonce_revelation { level ; nonce }) nonces in Seed_nonce_revelation { level ; nonce }) nonces in
Client_node_rpcs.Blocks.net_id cctxt block >>=? fun net_id -> let block = Client_rpcs.last_mined_block block in
Client_proto_rpcs.Helpers.Forge.Anonymous.operations cctxt Client_node_rpcs.Blocks.info rpc_config block >>=? fun bi ->
block ~net_id operations >>=? fun bytes -> Client_proto_rpcs.Helpers.Forge.Anonymous.operations rpc_config
Client_node_rpcs.inject_operation cctxt ?force ?async bytes >>=? fun oph -> block ~net_id:bi.net_id ~branch:bi.hash operations >>=? fun bytes ->
Client_node_rpcs.inject_operation rpc_config ?force ?async bytes >>=? fun oph ->
return oph return oph
type Error_monad.error += Bad_revelation type Error_monad.error += Bad_revelation

68
src/client/embedded/alpha/client_proto_context.ml
View File

@ -17,11 +17,31 @@ module Ed25519 = Environment.Ed25519
let get_balance cctxt block contract = let get_balance cctxt block contract =
Client_proto_rpcs.Context.Contract.balance cctxt block contract Client_proto_rpcs.Context.Contract.balance cctxt block contract
let rec find_predecessor rpc_config h n =
if n <= 0 then
return (`Hash h)
else
Client_node_rpcs.Blocks.predecessor rpc_config (`Hash h) >>=? fun h ->
find_predecessor rpc_config h (n-1)
let get_branch rpc_config block branch =
let branch = Utils.unopt ~default:0 branch in (* TODO export parameter *)
let block = Client_rpcs.last_mined_block block in
begin
match block with
| `Head n -> return (`Head (n+branch))
| `Test_head n -> return (`Test_head (n+branch))
| `Hash h -> find_predecessor rpc_config h branch
| `Genesis -> return `Genesis
end >>=? fun block ->
Client_node_rpcs.Blocks.info rpc_config block >>=? fun { net_id ; hash } ->
return (net_id, hash)
let transfer rpc_config let transfer rpc_config
block ?force block ?force ?branch
~source ~src_pk ~src_sk ~destination ?arg ~amount ~fee () = ~source ~src_pk ~src_sk ~destination ?arg ~amount ~fee () =
let open Cli_entries in let open Cli_entries in
Client_node_rpcs.Blocks.net_id rpc_config block >>=? fun net_id -> get_branch rpc_config block branch >>=? fun (net_id, branch) ->
begin match arg with begin match arg with
| Some arg -> | Some arg ->
Client_proto_programs.parse_data arg >>=? fun arg -> Client_proto_programs.parse_data arg >>=? fun arg ->
@ -33,7 +53,7 @@ let transfer rpc_config
let counter = Int32.succ pcounter in let counter = Int32.succ pcounter in
Client_proto_rpcs.Helpers.Forge.Manager.transaction Client_proto_rpcs.Helpers.Forge.Manager.transaction
rpc_config block rpc_config block
~net_id ~source ~sourcePubKey:src_pk ~counter ~amount ~net_id ~branch ~source ~sourcePubKey:src_pk ~counter ~amount
~destination ?parameters ~fee () >>=? fun bytes -> ~destination ?parameters ~fee () >>=? fun bytes ->
Client_node_rpcs.Blocks.predecessor rpc_config block >>=? fun predecessor -> Client_node_rpcs.Blocks.predecessor rpc_config block >>=? fun predecessor ->
let signature = Ed25519.sign src_sk bytes in let signature = Ed25519.sign src_sk bytes in
@ -66,22 +86,22 @@ let originate rpc_config ?force ~block ?signature bytes =
(List.length contracts) (List.length contracts)
let originate_account rpc_config let originate_account rpc_config
block ?force block ?force ?branch
~source ~src_pk ~src_sk ~manager_pkh ~source ~src_pk ~src_sk ~manager_pkh
?delegatable ?spendable ?delegate ~balance ~fee () = ?delegatable ?spendable ?delegate ~balance ~fee () =
Client_node_rpcs.Blocks.net_id rpc_config block >>=? fun net_id -> get_branch rpc_config block branch >>=? fun (net_id, branch) ->
Client_proto_rpcs.Context.Contract.counter Client_proto_rpcs.Context.Contract.counter
rpc_config block source >>=? fun pcounter -> rpc_config block source >>=? fun pcounter ->
let counter = Int32.succ pcounter in let counter = Int32.succ pcounter in
Client_proto_rpcs.Helpers.Forge.Manager.origination rpc_config block Client_proto_rpcs.Helpers.Forge.Manager.origination rpc_config block
~net_id ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh ~net_id ~branch ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh
~counter ~balance ?spendable ~counter ~balance ?spendable
?delegatable ?delegatePubKey:delegate ~fee () >>=? fun bytes -> ?delegatable ?delegatePubKey:delegate ~fee () >>=? fun bytes ->
let signature = Ed25519.sign src_sk bytes in let signature = Ed25519.sign src_sk bytes in
originate rpc_config ?force ~block ~signature bytes originate rpc_config ?force ~block ~signature bytes
let originate_contract rpc_config let originate_contract rpc_config
block ?force block ?force ?branch
~source ~src_pk ~src_sk ~manager_pkh ~balance ?delegatable ?delegatePubKey ~source ~src_pk ~src_sk ~manager_pkh ~balance ?delegatable ?delegatePubKey
~(code:Script.code) ~init ~fee () = ~(code:Script.code) ~init ~fee () =
Client_proto_programs.parse_data init >>=? fun storage -> Client_proto_programs.parse_data init >>=? fun storage ->
@ -89,33 +109,33 @@ let originate_contract rpc_config
Client_proto_rpcs.Context.Contract.counter Client_proto_rpcs.Context.Contract.counter
rpc_config block source >>=? fun pcounter -> rpc_config block source >>=? fun pcounter ->
let counter = Int32.succ pcounter in let counter = Int32.succ pcounter in
Client_node_rpcs.Blocks.net_id rpc_config block >>=? fun net_id -> get_branch rpc_config block branch >>=? fun (net_id, branch) ->
Client_proto_rpcs.Helpers.Forge.Manager.origination rpc_config block Client_proto_rpcs.Helpers.Forge.Manager.origination rpc_config block
~net_id ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh ~net_id ~branch ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh
~counter ~balance ~spendable:!spendable ~counter ~balance ~spendable:!spendable
?delegatable ?delegatePubKey ?delegatable ?delegatePubKey
~script:{ code ; storage } ~fee () >>=? fun bytes -> ~script:{ code ; storage } ~fee () >>=? fun bytes ->
let signature = Ed25519.sign src_sk bytes in let signature = Ed25519.sign src_sk bytes in
originate rpc_config ?force ~block ~signature bytes originate rpc_config ?force ~block ~signature bytes
let faucet rpc_config block ?force ~manager_pkh () = let faucet rpc_config block ?force ?branch ~manager_pkh () =
Client_node_rpcs.Blocks.net_id rpc_config block >>=? fun net_id -> get_branch rpc_config block branch >>=? fun (net_id, branch) ->
Client_proto_rpcs.Context.faucet_counter rpc_config block >>=? fun pcounter -> Client_proto_rpcs.Context.faucet_counter rpc_config block >>=? fun pcounter ->
let counter = Int32.succ pcounter in let counter = Int32.succ pcounter in
Client_proto_rpcs.Helpers.Forge.Anonymous.faucet Client_proto_rpcs.Helpers.Forge.Anonymous.faucet
rpc_config block ~net_id ~id:manager_pkh counter >>=? fun bytes -> rpc_config block ~net_id ~branch ~id:manager_pkh counter >>=? fun bytes ->
originate rpc_config ?force ~block bytes originate rpc_config ?force ~block bytes
let delegate_contract rpc_config let delegate_contract rpc_config
block ?force block ?force ?branch
~source ?src_pk ~manager_sk ~source ?src_pk ~manager_sk
~fee delegate_opt = ~fee delegate_opt =
Client_node_rpcs.Blocks.net_id rpc_config block >>=? fun net_id -> get_branch rpc_config block branch >>=? fun (net_id, branch) ->
Client_proto_rpcs.Context.Contract.counter Client_proto_rpcs.Context.Contract.counter
rpc_config block source >>=? fun pcounter -> rpc_config block source >>=? fun pcounter ->
let counter = Int32.succ pcounter in let counter = Int32.succ pcounter in
Client_proto_rpcs.Helpers.Forge.Manager.delegation rpc_config block Client_proto_rpcs.Helpers.Forge.Manager.delegation rpc_config block
~net_id ~source ?sourcePubKey:src_pk ~counter ~fee delegate_opt ~net_id ~branch ~source ?sourcePubKey:src_pk ~counter ~fee delegate_opt
>>=? fun bytes -> >>=? fun bytes ->
let signature = Environment.Ed25519.sign manager_sk bytes in let signature = Environment.Ed25519.sign manager_sk bytes in
let signed_bytes = MBytes.concat bytes signature in let signed_bytes = MBytes.concat bytes signature in
@ -125,18 +145,6 @@ let delegate_contract rpc_config
assert (Operation_hash.equal oph injected_oph) ; assert (Operation_hash.equal oph injected_oph) ;
return oph return oph
let dictate rpc_config block command seckey =
Client_node_rpcs.Blocks.net_id rpc_config block >>=? fun net_id ->
Client_proto_rpcs.Helpers.Forge.Dictator.operation
rpc_config block ~net_id command >>=? fun bytes ->
let signature = Ed25519.sign seckey bytes in
let signed_bytes = MBytes.concat bytes signature in
let oph = Operation_hash.hash_bytes [ signed_bytes ] in
Client_node_rpcs.inject_operation
rpc_config signed_bytes >>=? fun injected_oph ->
assert (Operation_hash.equal oph injected_oph) ;
return oph
let list_contract_labels cctxt block = let list_contract_labels cctxt block =
Client_proto_rpcs.Context.Contract.list Client_proto_rpcs.Context.Contract.list
cctxt.rpc_config block >>=? fun contracts -> cctxt.rpc_config block >>=? fun contracts ->
@ -207,9 +215,11 @@ let group =
title = "Block contextual commands (see option -block)" } title = "Block contextual commands (see option -block)" }
let dictate rpc_config block command seckey = let dictate rpc_config block command seckey =
Client_node_rpcs.Blocks.net_id rpc_config block >>=? fun net_id -> let block = Client_rpcs.last_mined_block block in
Client_node_rpcs.Blocks.info
rpc_config block >>=? fun { net_id ; hash = branch } ->
Client_proto_rpcs.Helpers.Forge.Dictator.operation Client_proto_rpcs.Helpers.Forge.Dictator.operation
rpc_config block ~net_id command >>=? fun bytes -> rpc_config block ~net_id ~branch command >>=? fun bytes ->
let signature = Ed25519.sign seckey bytes in let signature = Ed25519.sign seckey bytes in
let signed_bytes = MBytes.concat bytes signature in let signed_bytes = MBytes.concat bytes signature in
let oph = Operation_hash.hash_bytes [ signed_bytes ] in let oph = Operation_hash.hash_bytes [ signed_bytes ] in

4
src/client/embedded/alpha/client_proto_context.mli
View File

@ -19,6 +19,7 @@ val transfer:
Client_rpcs.config -> Client_rpcs.config ->
Client_proto_rpcs.block -> Client_proto_rpcs.block ->
?force:bool -> ?force:bool ->
?branch:int ->
source:Contract.t -> source:Contract.t ->
src_pk:public_key -> src_pk:public_key ->
src_sk:secret_key -> src_sk:secret_key ->
@ -32,6 +33,7 @@ val originate_account:
Client_rpcs.config -> Client_rpcs.config ->
Client_proto_rpcs.block -> Client_proto_rpcs.block ->
?force:bool -> ?force:bool ->
?branch:int ->
source:Contract.t -> source:Contract.t ->
src_pk:public_key -> src_pk:public_key ->
src_sk:secret_key -> src_sk:secret_key ->
@ -47,6 +49,7 @@ val originate_contract:
Client_rpcs.config -> Client_rpcs.config ->
Client_proto_rpcs.block -> Client_proto_rpcs.block ->
?force:bool -> ?force:bool ->
?branch:int ->
source:Contract.t -> source:Contract.t ->
src_pk:public_key -> src_pk:public_key ->
src_sk:secret_key -> src_sk:secret_key ->
@ -63,6 +66,7 @@ val delegate_contract:
Client_rpcs.config -> Client_rpcs.config ->
Client_proto_rpcs.block -> Client_proto_rpcs.block ->
?force:bool -> ?force:bool ->
?branch:int ->
source:Contract.t -> source:Contract.t ->
?src_pk:public_key -> ?src_pk:public_key ->
manager_sk:secret_key -> manager_sk:secret_key ->

56
src/client/embedded/alpha/client_proto_rpcs.ml
View File

@ -190,25 +190,25 @@ module Helpers = struct
module Manager = struct module Manager = struct
let operations cctxt let operations cctxt
block ~net_id ~source ?sourcePubKey ~counter ~fee operations = block ~net_id ~branch ~source ?sourcePubKey ~counter ~fee operations =
let ops = let ops =
Manager_operations { source ; public_key = sourcePubKey ; Manager_operations { source ; public_key = sourcePubKey ;
counter ; operations ; fee } in counter ; operations ; fee } in
(call_error_service1 cctxt Services.Helpers.Forge.operations block (call_error_service1 cctxt Services.Helpers.Forge.operations block
({net_id}, Sourced_operations ops)) ({net_id ; branch }, Sourced_operations ops))
let transaction cctxt let transaction cctxt
block ~net_id ~source ?sourcePubKey ~counter block ~net_id ~branch ~source ?sourcePubKey ~counter
~amount ~destination ?parameters ~fee ()= ~amount ~destination ?parameters ~fee ()=
operations cctxt block ~net_id ~source ?sourcePubKey ~counter ~fee operations cctxt block ~net_id ~branch ~source ?sourcePubKey ~counter ~fee
Tezos_context.[Transaction { amount ; parameters ; destination }] Tezos_context.[Transaction { amount ; parameters ; destination }]
let origination cctxt let origination cctxt
block ~net_id block ~net_id ~branch
~source ?sourcePubKey ~counter ~source ?sourcePubKey ~counter
~managerPubKey ~balance ~managerPubKey ~balance
?(spendable = true) ?(spendable = true)
?(delegatable = true) ?(delegatable = true)
?delegatePubKey ?script ~fee () = ?delegatePubKey ?script ~fee () =
operations cctxt block ~net_id ~source ?sourcePubKey ~counter ~fee operations cctxt block ~net_id ~branch ~source ?sourcePubKey ~counter ~fee
Tezos_context.[ Tezos_context.[
Origination { manager = managerPubKey ; Origination { manager = managerPubKey ;
delegate = delegatePubKey ; delegate = delegatePubKey ;
@ -218,53 +218,53 @@ module Helpers = struct
credit = balance } credit = balance }
] ]
let delegation cctxt let delegation cctxt
block ~net_id ~source ?sourcePubKey ~counter ~fee delegate = block ~net_id ~branch ~source ?sourcePubKey ~counter ~fee delegate =
operations cctxt block ~net_id ~source ?sourcePubKey ~counter ~fee operations cctxt block ~net_id ~branch ~source ?sourcePubKey ~counter ~fee
Tezos_context.[Delegation delegate] Tezos_context.[Delegation delegate]
end end
module Delegate = struct module Delegate = struct
let operations cctxt let operations cctxt
block ~net_id ~source operations = block ~net_id ~branch ~source operations =
let ops = Delegate_operations { source ; operations } in let ops = Delegate_operations { source ; operations } in
(call_error_service1 cctxt Services.Helpers.Forge.operations block (call_error_service1 cctxt Services.Helpers.Forge.operations block
({net_id}, Sourced_operations ops)) ({net_id ; branch}, Sourced_operations ops))
let endorsement cctxt let endorsement cctxt
b ~net_id ~source ~block ~slot () = b ~net_id ~branch ~source ~block ~slot () =
operations cctxt b ~net_id ~source operations cctxt b ~net_id ~branch ~source
Tezos_context.[Endorsement { block ; slot }] Tezos_context.[Endorsement { block ; slot }]
let proposals cctxt let proposals cctxt
b ~net_id ~source ~period ~proposals () = b ~net_id ~branch ~source ~period ~proposals () =
operations cctxt b ~net_id ~source operations cctxt b ~net_id ~branch ~source
Tezos_context.[Proposals { period ; proposals }] Tezos_context.[Proposals { period ; proposals }]
let ballot cctxt let ballot cctxt
b ~net_id ~source ~period ~proposal ~ballot () = b ~net_id ~branch ~source ~period ~proposal ~ballot () =
operations cctxt b ~net_id ~source operations cctxt b ~net_id ~branch ~source
Tezos_context.[Ballot { period ; proposal ; ballot }] Tezos_context.[Ballot { period ; proposal ; ballot }]
end end
module Dictator = struct module Dictator = struct
let operation cctxt let operation cctxt
block ~net_id operation = block ~net_id ~branch operation =
let op = Dictator_operation operation in let op = Dictator_operation operation in
(call_error_service1 cctxt Services.Helpers.Forge.operations block (call_error_service1 cctxt Services.Helpers.Forge.operations block
({net_id}, Sourced_operations op)) ({net_id ; branch}, Sourced_operations op))
let activate cctxt let activate cctxt
b ~net_id hash = b ~net_id ~branch hash =
operation cctxt b ~net_id (Activate hash) operation cctxt b ~net_id ~branch (Activate hash)
let activate_testnet cctxt let activate_testnet cctxt
b ~net_id hash = b ~net_id ~branch hash =
operation cctxt b ~net_id (Activate_testnet hash) operation cctxt b ~net_id ~branch (Activate_testnet hash)
end end
module Anonymous = struct module Anonymous = struct
let operations cctxt block ~net_id operations = let operations cctxt block ~net_id ~branch operations =
(call_error_service1 cctxt Services.Helpers.Forge.operations block (call_error_service1 cctxt Services.Helpers.Forge.operations block
({net_id}, Anonymous_operations operations)) ({net_id ; branch}, Anonymous_operations operations))
let seed_nonce_revelation cctxt let seed_nonce_revelation cctxt
block ~net_id ~level ~nonce () = block ~net_id ~branch ~level ~nonce () =
operations cctxt block ~net_id [Seed_nonce_revelation { level ; nonce }] operations cctxt block ~net_id ~branch [Seed_nonce_revelation { level ; nonce }]
let faucet cctxt let faucet cctxt
block ~net_id ~id counter = block ~net_id ~branch ~id counter =
let nonce = Sodium.Random.Bigbytes.generate 16 in let nonce = Sodium.Random.Bigbytes.generate 16 in
operations cctxt block ~net_id [Faucet { id ; counter ; nonce }] operations cctxt block ~net_id ~branch [Faucet { id ; counter ; nonce }]
end end
let empty_proof_of_work_nonce = let empty_proof_of_work_nonce =
MBytes.of_string MBytes.of_string

32
src/client/embedded/alpha/client_proto_rpcs.mli
View File

@ -10,12 +10,7 @@
val string_of_errors: error list -> string val string_of_errors: error list -> string
val handle_error: Client_commands.context -> 'a tzresult -> 'a Lwt.t val handle_error: Client_commands.context -> 'a tzresult -> 'a Lwt.t
type block = [ type block = Node_rpc_services.Blocks.block
| `Genesis
| `Head of int | `Prevalidation
| `Test_head of int | `Test_prevalidation
| `Hash of Block_hash.t
]
val header: val header:
Client_rpcs.config -> block -> Block_header.t tzresult Lwt.t Client_rpcs.config -> block -> Block_header.t tzresult Lwt.t
@ -208,6 +203,7 @@ module Helpers : sig
Client_rpcs.config -> Client_rpcs.config ->
block -> block ->
net_id:Net_id.t -> net_id:Net_id.t ->
branch:Block_hash.t ->
source:Contract.t -> source:Contract.t ->
?sourcePubKey:public_key -> ?sourcePubKey:public_key ->
counter:int32 -> counter:int32 ->
@ -218,6 +214,7 @@ module Helpers : sig
Client_rpcs.config -> Client_rpcs.config ->
block -> block ->
net_id:Net_id.t -> net_id:Net_id.t ->
branch:Block_hash.t ->
source:Contract.t -> source:Contract.t ->
?sourcePubKey:public_key -> ?sourcePubKey:public_key ->
counter:int32 -> counter:int32 ->
@ -230,6 +227,7 @@ module Helpers : sig
Client_rpcs.config -> Client_rpcs.config ->
block -> block ->
net_id:Net_id.t -> net_id:Net_id.t ->
branch:Block_hash.t ->
source:Contract.t -> source:Contract.t ->
?sourcePubKey:public_key -> ?sourcePubKey:public_key ->
counter:int32 -> counter:int32 ->
@ -246,6 +244,7 @@ module Helpers : sig
Client_rpcs.config -> Client_rpcs.config ->
block -> block ->
net_id:Net_id.t -> net_id:Net_id.t ->
branch:Block_hash.t ->
source:Contract.t -> source:Contract.t ->
?sourcePubKey:public_key -> ?sourcePubKey:public_key ->
counter:int32 -> counter:int32 ->
@ -258,18 +257,21 @@ module Helpers : sig
Client_rpcs.config -> Client_rpcs.config ->
block -> block ->
net_id:Net_id.t -> net_id:Net_id.t ->
branch:Block_hash.t ->
dictator_operation -> dictator_operation ->
MBytes.t tzresult Lwt.t MBytes.t tzresult Lwt.t
val activate: val activate:
Client_rpcs.config -> Client_rpcs.config ->
block -> block ->
net_id:Net_id.t -> net_id:Net_id.t ->
branch:Block_hash.t ->
Protocol_hash.t -> Protocol_hash.t ->
MBytes.t tzresult Lwt.t MBytes.t tzresult Lwt.t
val activate_testnet: val activate_testnet:
Client_rpcs.config -> Client_rpcs.config ->
block -> block ->
net_id:Net_id.t -> net_id:Net_id.t ->
branch:Block_hash.t ->
Protocol_hash.t -> Protocol_hash.t ->
MBytes.t tzresult Lwt.t MBytes.t tzresult Lwt.t
end end
@ -278,6 +280,7 @@ module Helpers : sig
Client_rpcs.config -> Client_rpcs.config ->
block -> block ->
net_id:Net_id.t -> net_id:Net_id.t ->
branch:Block_hash.t ->
source:public_key -> source:public_key ->
delegate_operation list -> delegate_operation list ->
MBytes.t tzresult Lwt.t MBytes.t tzresult Lwt.t
@ -285,6 +288,7 @@ module Helpers : sig
Client_rpcs.config -> Client_rpcs.config ->
block -> block ->
net_id:Net_id.t -> net_id:Net_id.t ->
branch:Block_hash.t ->
source:public_key -> source:public_key ->
block:Block_hash.t -> block:Block_hash.t ->
slot:int -> slot:int ->
@ -293,6 +297,7 @@ module Helpers : sig
Client_rpcs.config -> Client_rpcs.config ->
block -> block ->
net_id:Net_id.t -> net_id:Net_id.t ->
branch:Block_hash.t ->
source:public_key -> source:public_key ->
period:Voting_period.t -> period:Voting_period.t ->
proposals:Hash.Protocol_hash.t list -> proposals:Hash.Protocol_hash.t list ->
@ -301,6 +306,7 @@ module Helpers : sig
Client_rpcs.config -> Client_rpcs.config ->
block -> block ->
net_id:Net_id.t -> net_id:Net_id.t ->
branch:Block_hash.t ->
source:public_key -> source:public_key ->
period:Voting_period.t -> period:Voting_period.t ->
proposal:Hash.Protocol_hash.t -> proposal:Hash.Protocol_hash.t ->
@ -312,12 +318,14 @@ module Helpers : sig
Client_rpcs.config -> Client_rpcs.config ->
block -> block ->
net_id:Net_id.t -> net_id:Net_id.t ->
branch:Block_hash.t ->
anonymous_operation list -> anonymous_operation list ->
MBytes.t tzresult Lwt.t MBytes.t tzresult Lwt.t
val seed_nonce_revelation: val seed_nonce_revelation:
Client_rpcs.config -> Client_rpcs.config ->
block -> block ->
net_id:Net_id.t -> net_id:Net_id.t ->
branch:Block_hash.t ->
level:Raw_level.t -> level:Raw_level.t ->
nonce:Nonce.t -> nonce:Nonce.t ->
unit -> MBytes.t tzresult Lwt.t unit -> MBytes.t tzresult Lwt.t
@ -325,6 +333,7 @@ module Helpers : sig
Client_rpcs.config -> Client_rpcs.config ->
block -> block ->
net_id:Net_id.t -> net_id:Net_id.t ->
branch:Block_hash.t ->
id:public_key_hash -> id:public_key_hash ->
int32 -> MBytes.t tzresult Lwt.t int32 -> MBytes.t tzresult Lwt.t
end end
@ -335,17 +344,6 @@ module Helpers : sig
seed_nonce_hash: Nonce_hash.t -> seed_nonce_hash: Nonce_hash.t ->
?proof_of_work_nonce: MBytes.t -> ?proof_of_work_nonce: MBytes.t ->
unit -> MBytes.t tzresult Lwt.t unit -> MBytes.t tzresult Lwt.t
(** [block cctxt root ~net ~predecessor ~timestamp ~fitness
~operations ~level ~priority ~seed_nonce_hash
~proof_of_work_nonce ()] returns the binary serialization of
a block header (comprising the shell and protocol-specific
part), rooted at [root], belonging to [net], with
predecessor [predecessor], [timestamp], [fitness],
associated operations [operations], level [level] (the
protocol cannot deduce it from [predecessor] on its own),
priority [priority] (the priority of this miner in the
mining queue associated to [level]), [seed_nonce_hash] (the
chosen seed that we will reveal in the next cycle). *)
end end
module Parse : sig module Parse : sig

2
src/node/shell/node.ml
View File

@ -230,7 +230,7 @@ module RPC = struct
Lwt.return v Lwt.return v
else else
State.Block.predecessor v >>= function State.Block.predecessor v >>= function
| None -> Lwt.fail Not_found | None -> Lwt.return v
| Some v -> predecessor net_db (n-1) v | Some v -> predecessor net_db (n-1) v
let block_info node (block: block) = let block_info node (block: block) =

38
src/node/shell/prevalidator.ml
View File

@ -77,6 +77,12 @@ let create net_db =
let pending = Operation_hash.Table.create 53 in let pending = Operation_hash.Table.create 53 in
let head = ref head in let head = ref head in
let operations = ref empty_result in let operations = ref empty_result in
Chain_traversal.live_blocks
!head
(State.Block.max_operations_ttl !head)
>>= fun (live_blocks, live_operations) ->
let live_blocks = ref live_blocks in
let live_operations = ref live_operations in
let running_validation = ref Lwt.return_unit in let running_validation = ref Lwt.return_unit in
let unprocessed = ref Operation_hash.Set.empty in let unprocessed = ref Operation_hash.Set.empty in
let broadcast_unprocessed = ref false in let broadcast_unprocessed = ref false in
@ -98,22 +104,24 @@ let create net_db =
if Operation_hash.Set.is_empty !unprocessed then if Operation_hash.Set.is_empty !unprocessed then
Lwt.return () Lwt.return ()
else else
(* We assume that `!unprocessed` does not contain any operations
from `!operations`. *)
let ops = !unprocessed in let ops = !unprocessed in
let broadcast = !broadcast_unprocessed in let broadcast = !broadcast_unprocessed in
unprocessed := Operation_hash.Set.empty ; unprocessed := Operation_hash.Set.empty ;
broadcast_unprocessed := false ; broadcast_unprocessed := false ;
let ops = Operation_hash.Set.diff ops !live_operations in
live_operations := Operation_hash.Set.(fold add) !live_operations ops ;
running_validation := begin running_validation := begin
begin begin
Lwt_list.map_p Lwt_list.filter_map_p
(fun h -> (fun h ->
Distributed_db.Operation.read_opt net_db h >>= function Distributed_db.Operation.read_opt net_db h >>= function
| Some po -> | Some po when Block_hash.Set.mem po.shell.branch !live_blocks ->
(* FIXME add the operation on a bounded set of
to-be-ignored operations.*)
Distributed_db.Operation.clear net_db h ;
Lwt.return_some (h, po) Lwt.return_some (h, po)
| None -> Lwt.return_none) | Some _ | None -> Lwt.return_none)
(Operation_hash.Set.elements ops) >>= fun rops -> (Operation_hash.Set.elements ops) >>= fun rops ->
let rops = Utils.unopt_list rops in
(Lwt.return !validation_state >>=? fun validation_state -> (Lwt.return !validation_state >>=? fun validation_state ->
(prevalidate validation_state ~sort:true rops >>= return)) >>= function (prevalidate validation_state ~sort:true rops >>= return)) >>= function
| Ok (state, r) -> Lwt.return (Ok state, r) | Ok (state, r) -> Lwt.return (Ok state, r)
@ -165,9 +173,6 @@ let create net_db =
let prevalidation_worker = let prevalidation_worker =
let rec worker_loop () = let rec worker_loop () =
(* TODO cleanup the mempool from outdated operation (1h like
Bitcoin ?). And log the removal in some statistic associated
to then peers that informed us of the operation. *)
(* TODO lookup in `!pending` for 'outdated' ops and re-add them (* TODO lookup in `!pending` for 'outdated' ops and re-add them
in `unprocessed` (e.g. if the previous tentative was in `unprocessed` (e.g. if the previous tentative was
more 5 seconds ago) *) more 5 seconds ago) *)
@ -229,13 +234,12 @@ let create net_db =
Lwt.return_unit Lwt.return_unit
end end
| `Register (gid, ops) -> | `Register (gid, ops) ->
Lwt_list.filter_p
(fun op ->
Distributed_db.Operation.known net_db op >|= not)
ops >>= fun new_ops ->
let known_ops, unknown_ops = let known_ops, unknown_ops =
List.partition List.partition
(fun op -> Operation_hash.Table.mem pending op) new_ops in (fun op ->
Operation_hash.Table.mem pending op
|| Operation_hash.Set.mem op !live_operations)
ops in
let fetch op = let fetch op =
Distributed_db.Operation.fetch Distributed_db.Operation.fetch
net_db ~peer:gid op () >>= fun _op -> net_db ~peer:gid op () >>= fun _op ->
@ -260,6 +264,10 @@ let create net_db =
| `Flush (new_head : State.Block.t) -> | `Flush (new_head : State.Block.t) ->
list_pendings ~from_block:!head ~to_block:new_head list_pendings ~from_block:!head ~to_block:new_head
(preapply_result_operations !operations) >>= fun new_mempool -> (preapply_result_operations !operations) >>= fun new_mempool ->
Chain_traversal.live_blocks
new_head
(State.Block.max_operations_ttl new_head)
>>= fun (new_live_blocks, new_live_operations) ->
lwt_debug "flush %a (mempool: %d)" lwt_debug "flush %a (mempool: %d)"
Block_hash.pp_short (State.Block.hash new_head) Block_hash.pp_short (State.Block.hash new_head)
(Operation_hash.Set.cardinal new_mempool) >>= fun () -> (Operation_hash.Set.cardinal new_mempool) >>= fun () ->
@ -269,6 +277,8 @@ let create net_db =
broadcast_unprocessed := false ; broadcast_unprocessed := false ;
unprocessed := new_mempool ; unprocessed := new_mempool ;
timestamp := Time.now () ; timestamp := Time.now () ;
live_blocks := new_live_blocks ;
live_operations := new_live_operations ;
(* Reset the prevalidation context. *) (* Reset the prevalidation context. *)
reset_validation_state new_head !timestamp) reset_validation_state new_head !timestamp)
q >>= fun () -> q >>= fun () ->

2
src/node/shell/state.ml
View File

@ -296,6 +296,8 @@ module Block = struct
let message { contents = { message } } = message let message { contents = { message } } = message
let operation_list_count { contents = { operation_list_count } } = let operation_list_count { contents = { operation_list_count } } =
operation_list_count operation_list_count
let max_operations_ttl { contents = { max_operations_ttl } } =
max_operations_ttl
let known_valid net_state hash = let known_valid net_state hash =
Shared.use net_state.block_store begin fun store -> Shared.use net_state.block_store begin fun store ->

1
src/node/shell/state.mli
View File

@ -120,6 +120,7 @@ module Block : sig
val net_id: t -> Net_id.t val net_id: t -> Net_id.t
val level: t -> Int32.t val level: t -> Int32.t
val message: t -> string val message: t -> string
val max_operations_ttl: t -> int
val predecessor: t -> block option Lwt.t val predecessor: t -> block option Lwt.t

65
src/node/shell/validator.ml
View File

@ -155,6 +155,8 @@ type error +=
| Non_increasing_fitness | Non_increasing_fitness
| Wrong_level of Int32.t * Int32.t | Wrong_level of Int32.t * Int32.t
| Wrong_proto_level of int * int | Wrong_proto_level of int * int
| Replayed_operation of Operation_hash.t
| Outdated_operation of Operation_hash.t * Block_hash.t
let () = let () =
Error_monad.register_error_kind Error_monad.register_error_kind
@ -204,7 +206,35 @@ let () =
(req "expected" uint8) (req "expected" uint8)
(req "provided" uint8)) (req "provided" uint8))
(function Wrong_proto_level (e, g) -> Some (e, g) | _ -> None) (function Wrong_proto_level (e, g) -> Some (e, g) | _ -> None)
(fun (e, g) -> Wrong_proto_level (e, g)) (fun (e, g) -> Wrong_proto_level (e, g)) ;
register_error_kind
`Permanent
~id:"validator.replayed_operation"
~title:"Replayed operation"
~description:"The block contains an operation that was previously \
included in the chain"
~pp:(fun ppf oph ->
Format.fprintf ppf
"The operation %a was previously included in the chain."
Operation_hash.pp oph)
Data_encoding.(obj1 (req "hash" Operation_hash.encoding))
(function Replayed_operation oph -> Some oph | _ -> None)
(function oph -> Replayed_operation oph) ;
register_error_kind
`Permanent
~id:"validator.outdated_operations"
~title:"Outdated operation"
~description:"The block contains an operation which is outdated."
~pp:(fun ppf (oph, bh)->
Format.fprintf ppf
"The operation %a is outdated (%a)"
Operation_hash.pp oph
Block_hash.pp bh)
Data_encoding.(obj2
(req "operation" Operation_hash.encoding)
(req "block" Block_hash.encoding))
(function Outdated_operation (oph, bh) -> Some (oph, bh) | _ -> None)
(function (oph, bh) -> Outdated_operation (oph, bh))
let apply_block net_state db let apply_block net_state db
(pred: State.Block.t) hash (block: Block_header.t) = (pred: State.Block.t) hash (block: Block_header.t) =
@ -215,8 +245,7 @@ let apply_block net_state db
lwt_log_notice "validate block %a (after %a), net %a" lwt_log_notice "validate block %a (after %a), net %a"
Block_hash.pp_short hash Block_hash.pp_short hash
Block_hash.pp_short block.shell.predecessor Block_hash.pp_short block.shell.predecessor
Net_id.pp id Net_id.pp id >>= fun () ->
>>= fun () ->
fail_unless fail_unless
(Int32.succ pred_header.shell.level = block.shell.level) (Int32.succ pred_header.shell.level = block.shell.level)
(Wrong_level (Int32.succ pred_header.shell.level, (Wrong_level (Int32.succ pred_header.shell.level,
@ -246,6 +275,29 @@ let apply_block net_state db
else else
return () return ()
end >>=? fun () -> end >>=? fun () ->
begin
Chain_traversal.live_blocks
pred (State.Block.max_operations_ttl pred) >>= fun (live_blocks,
live_operations) ->
let rec assert_no_duplicates live_operations = function
| [] -> return ()
| oph :: ophs ->
if Operation_hash.Set.mem oph live_operations then
fail (Replayed_operation oph)
else
assert_no_duplicates
(Operation_hash.Set.add oph live_operations) ophs in
let assert_live operations =
List.fold_left
(fun acc op ->
acc >>=? fun () ->
fail_unless
(Block_hash.Set.mem op.Operation.shell.branch live_blocks)
(Outdated_operation (Operation.hash op, op.shell.branch)))
(return ()) operations in
assert_no_duplicates live_operations operation_hashes >>=? fun () ->
assert_live operations
end >>=? fun () ->
Context.get_protocol pred_context >>= fun pred_protocol_hash -> Context.get_protocol pred_context >>= fun pred_protocol_hash ->
begin begin
match Updater.get pred_protocol_hash with match Updater.get pred_protocol_hash with
@ -295,6 +347,13 @@ let apply_block net_state db
expected = block.shell.fitness ; expected = block.shell.fitness ;
found = new_context.fitness ; found = new_context.fitness ;
}) >>=? fun () -> }) >>=? fun () ->
let max_operations_ttl =
max 0
(min
((State.Block.max_operations_ttl pred)+1)
new_context.max_operations_ttl) in
let new_context =
{ new_context with max_operations_ttl } in
lwt_log_info "validation of %a: success" lwt_log_info "validation of %a: success"
Block_hash.pp_short hash >>= fun () -> Block_hash.pp_short hash >>= fun () ->
return new_context return new_context

3
src/proto/alpha/operation_repr.ml
View File

@ -364,8 +364,7 @@ let parse hash (op: Operation.t) =
Encoding.signed_proto_operation_encoding Encoding.signed_proto_operation_encoding
op.proto with op.proto with
| Some (contents, signature) -> | Some (contents, signature) ->
let shell = { Operation.net_id = op.shell.net_id } in ok { hash ; shell = op.shell ; contents ; signature }
ok { hash ; shell ; contents ; signature }
| None -> error Cannot_parse_operation | None -> error Cannot_parse_operation
type error += Invalid_signature (* `Permanent *) type error += Invalid_signature (* `Permanent *)

1
src/proto/environment/tezos_data.mli
View File

@ -40,6 +40,7 @@ module Operation : sig
type shell_header = { type shell_header = {
net_id: Net_id.t ; net_id: Net_id.t ;
branch: Block_hash.t ;
} }
val shell_header_encoding: shell_header Data_encoding.t val shell_header_encoding: shell_header Data_encoding.t

9
src/utils/tezos_data.ml
View File

@ -93,14 +93,17 @@ module Operation = struct
type shell_header = { type shell_header = {
net_id: Net_id.t ; net_id: Net_id.t ;
branch: Block_hash.t ;
} }
let shell_header_encoding = let shell_header_encoding =
let open Data_encoding in let open Data_encoding in
conv conv
(fun { net_id } -> net_id) (fun { net_id ; branch } -> net_id, branch)
(fun net_id -> { net_id }) (fun (net_id, branch) -> { net_id ; branch })
(obj1 (req "net_id" Net_id.encoding)) (obj2
(req "net_id" Net_id.encoding)
(req "branch" Block_hash.encoding))
type t = { type t = {
shell: shell_header ; shell: shell_header ;

1
src/utils/tezos_data.mli
View File

@ -40,6 +40,7 @@ module Operation : sig
type shell_header = { type shell_header = {
net_id: Net_id.t ; net_id: Net_id.t ;
branch: Block_hash.t ;
} }
val shell_header_encoding: shell_header Data_encoding.t val shell_header_encoding: shell_header Data_encoding.t

2
test/proto_alpha/.merlin
View File

@ -17,6 +17,8 @@ S ../../src/proto
B ../../src/proto B ../../src/proto
S ../../src/client S ../../src/client
B ../../src/client B ../../src/client
S ../../src/client/embedded
B ../../src/client/embedded
S ../../src/client/embedded/alpha S ../../src/client/embedded/alpha
B ../../src/client/embedded/alpha B ../../src/client/embedded/alpha
S ../../src/client/embedded/alpha/baker S ../../src/client/embedded/alpha/baker

6
test/proto_alpha/proto_alpha_helpers.ml
View File

@ -250,6 +250,7 @@ module Protocol = struct
Client_proto_rpcs.Context.next_level rpc_config block >>=? fun next_level -> Client_proto_rpcs.Context.next_level rpc_config block >>=? fun next_level ->
Client_proto_rpcs.Helpers.Forge.Delegate.proposals rpc_config block Client_proto_rpcs.Helpers.Forge.Delegate.proposals rpc_config block
~net_id:block_info.net_id ~net_id:block_info.net_id
~branch:block_info.hash
~source:pk ~source:pk
~period:next_level.voting_period ~period:next_level.voting_period
~proposals ~proposals
@ -262,6 +263,7 @@ module Protocol = struct
Client_proto_rpcs.Context.next_level rpc_config block >>=? fun next_level -> Client_proto_rpcs.Context.next_level rpc_config block >>=? fun next_level ->
Client_proto_rpcs.Helpers.Forge.Delegate.ballot rpc_config block Client_proto_rpcs.Helpers.Forge.Delegate.ballot rpc_config block
~net_id:block_info.net_id ~net_id:block_info.net_id
~branch:block_info.hash
~source:pk ~source:pk
~period:next_level.voting_period ~period:next_level.voting_period
~proposal ~proposal
@ -440,6 +442,7 @@ module Endorse = struct
Client_proto_rpcs.Helpers.Forge.Delegate.endorsement rpc_config Client_proto_rpcs.Helpers.Forge.Delegate.endorsement rpc_config
block block
~net_id:net_id ~net_id:net_id
~branch:hash
~source ~source
~block:hash ~block:hash
~slot:slot ~slot:slot
@ -480,7 +483,7 @@ module Endorse = struct
forge_endorsement block contract.sk contract.pk slot forge_endorsement block contract.sk contract.pk 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 { Account.b1 ; b2 ; b3 ; b4 ; b5 } = let endorsers_list block =
let get_endorser_list result (account : Account.t) level block = let get_endorser_list result (account : Account.t) level block =
Client_proto_rpcs.Helpers.Rights.endorsement_rights_for_delegate Client_proto_rpcs.Helpers.Rights.endorsement_rights_for_delegate
rpc_config block account.pkh rpc_config block account.pkh
@ -489,6 +492,7 @@ module Endorse = struct
~last_level:level () >>|? fun slots -> ~last_level:level () >>|? fun slots ->
List.iter (fun (_,slot) -> result.(slot) <- account) slots List.iter (fun (_,slot) -> result.(slot) <- account) slots
in in
let { Account.b1 ; b2 ; b3 ; b4 ; b5 } = Account.bootstrap_accounts in
let result = Array.make 16 b1 in let result = Array.make 16 b1 in
Client_proto_rpcs.Context.level rpc_config block >>=? fun level -> Client_proto_rpcs.Context.level rpc_config block >>=? fun level ->
let level = Raw_level.succ @@ level.level in let level = Raw_level.succ @@ level.level in

1
test/proto_alpha/proto_alpha_helpers.mli
View File

@ -114,7 +114,6 @@ module Endorse : sig
val endorsers_list : val endorsers_list :
Client_alpha.Client_proto_rpcs.block -> Client_alpha.Client_proto_rpcs.block ->
Account.bootstrap_accounts ->
Account.t array tzresult Lwt.t Account.t array tzresult Lwt.t
val endorsement_rights : val endorsement_rights :

149
test/proto_alpha/test_endorsement.ml
View File

@ -14,6 +14,12 @@ open Client_alpha
module Helpers = Proto_alpha_helpers module Helpers = Proto_alpha_helpers
module Assert = Helpers.Assert 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 contract block = let test_double_endorsement contract block =
(* Double endorsement for the same level *) (* Double endorsement for the same level *)
@ -59,8 +65,7 @@ let contain_tzerror ?(msg="") ~f t =
failwith "@[<v 2>Unexpected error@ %a@]" pp_print_error error failwith "@[<v 2>Unexpected error@ %a@]" pp_print_error error
| _ -> return () | _ -> return ()
let test_wrong_delegate ~miner contract head = let test_wrong_delegate ~miner contract block =
let block = `Hash head in
begin begin
Helpers.Endorse.endorse ~slot:1 contract block >>=? fun op -> Helpers.Endorse.endorse ~slot:1 contract block >>=? fun op ->
Helpers.Mining.mine block miner [ op ] >>=? fun _ -> Helpers.Mining.mine block miner [ op ] >>=? fun _ ->
@ -95,8 +100,8 @@ let test_invalid_endorsement_slot contract block =
end res ; end res ;
return () return ()
let test_endorsement_rewards let test_endorsement_rewards block0 =
block ({ Helpers.Account.b5 = b1 ; _ } as baccounts) =
let get_endorser_except bs accounts = let get_endorser_except bs accounts =
let account, cpt = ref accounts.(0), ref 0 in let account, cpt = ref accounts.(0), ref 0 in
while List.mem !account bs do while List.mem !account bs do
@ -109,75 +114,74 @@ let test_endorsement_rewards
(* Endorsement Rights *) (* Endorsement Rights *)
(* #1 endorse & inject in a block *) (* #1 endorse & inject in a block *)
Helpers.Endorse.endorsers_list block baccounts >>=? fun accounts -> Helpers.Endorse.endorsers_list block0 >>=? fun accounts ->
get_endorser_except [ b1 ] accounts >>=? fun (account0, slot0) -> get_endorser_except [ b1 ] accounts >>=? fun (account0, slot0) ->
Helpers.Account.balance ~block account0 >>=? fun balance0 -> Helpers.Account.balance ~block:block0 account0 >>=? fun balance0 ->
Helpers.Endorse.endorse ~slot:slot0 account0 block >>=? fun ops -> Helpers.Endorse.endorse ~slot:slot0 account0 block0 >>=? fun op ->
Helpers.Mining.mine block b1 [ ops ] >>=? fun head0 -> Helpers.Mining.mine block0 b1 [ op ] >>=? fun hash1 ->
Helpers.display_level (`Hash head0) >>=? fun () -> Helpers.display_level (`Hash hash1) >>=? fun () ->
Assert.balance_equal ~block:(`Hash head0) ~msg:__LOC__ account0 Assert.balance_equal ~block:(`Hash hash1) ~msg:__LOC__ account0
(Int64.sub (Tez.to_cents balance0) bond) >>=? fun () -> (Int64.sub (Tez.to_cents balance0) bond) >>=? fun () ->
(* #2 endorse & inject in a block *) (* #2 endorse & inject in a block *)
let block0 = `Hash head0 in let block1 = `Hash hash1 in
Helpers.Endorse.endorsers_list block0 baccounts >>=? fun accounts -> Helpers.Endorse.endorsers_list block1 >>=? fun accounts ->
get_endorser_except [ b1 ; account0 ] accounts >>=? fun (account1, slot1) -> get_endorser_except [ b1 ; account0 ] accounts >>=? fun (account1, slot1) ->
Helpers.Account.balance ~block:block0 account1 >>=? fun balance1 -> Helpers.Account.balance ~block:block1 account1 >>=? fun balance1 ->
Helpers.Endorse.endorse ~slot:slot1 account1 block0 >>=? fun ops -> Helpers.Endorse.endorse ~slot:slot1 account1 block1 >>=? fun op ->
Helpers.Mining.mine block0 b1 [ ops ] >>=? fun head1 -> Helpers.Mining.mine block1 b1 [ op ] >>=? fun hash2 ->
Helpers.display_level (`Hash head1) >>=? fun () -> Helpers.display_level (`Hash hash2) >>=? fun () ->
Assert.balance_equal ~block:(`Hash head1) ~msg:__LOC__ account1 Assert.balance_equal ~block:(`Hash hash2) ~msg:__LOC__ account1
(Int64.sub (Tez.to_cents balance1) bond) >>=? fun () -> (Int64.sub (Tez.to_cents balance1) bond) >>=? fun () ->
(* Check rewards after one cycle for account0 *) (* Check rewards after one cycle for account0 *)
Helpers.Mining.mine (`Hash head1) b1 [] >>=? fun head2 -> Helpers.Mining.mine (`Hash hash2) b1 [] >>=? fun hash3 ->
Helpers.display_level (`Hash head2) >>=? fun () -> Helpers.display_level (`Hash hash3) >>=? fun () ->
Helpers.Mining.mine (`Hash head2) b1 [] >>=? fun head3 -> Helpers.Mining.mine (`Hash hash3) b1 [] >>=? fun hash4 ->
Helpers.display_level (`Hash head3) >>=? fun () -> Helpers.display_level (`Hash hash4) >>=? fun () ->
Helpers.Mining.mine (`Hash head3) b1 [] >>=? fun head4 -> Helpers.Mining.mine (`Hash hash4) b1 [] >>=? fun hash5 ->
Helpers.display_level (`Hash head4) >>=? fun () -> Helpers.display_level (`Hash hash5) >>=? fun () ->
Helpers.Mining.endorsement_reward block0 >>=? fun rw0 -> Helpers.Mining.endorsement_reward block1 >>=? fun rw0 ->
Assert.balance_equal ~block:(`Hash head4) ~msg:__LOC__ account0 Assert.balance_equal ~block:(`Hash hash5) ~msg:__LOC__ account0
(Int64.add (Tez.to_cents balance0) rw0) >>=? fun () -> (Int64.add (Tez.to_cents balance0) rw0) >>=? fun () ->
(* Check rewards after one cycle for account1 *) (* Check rewards after one cycle for account1 *)
Helpers.Mining.endorsement_reward (`Hash head1) >>=? fun rw1 -> Helpers.Mining.endorsement_reward (`Hash hash2) >>=? fun rw1 ->
Assert.balance_equal ~block:(`Hash head4) ~msg:__LOC__ account1 Assert.balance_equal ~block:(`Hash hash5) ~msg:__LOC__ account1
(Int64.add (Tez.to_cents balance1) rw1) >>=? fun () -> (Int64.add (Tez.to_cents balance1) rw1) >>=? fun () ->
(* #2 endorse and check reward only on the good chain *) (* #2 endorse and check reward only on the good chain *)
Helpers.Mining.mine (`Hash head4) b1 []>>=? fun head -> Helpers.Mining.mine (`Hash hash5) b1 []>>=? fun hash6a ->
Helpers.display_level (`Hash head) >>=? fun () -> Helpers.display_level (`Hash hash6a) >>=? fun () ->
Helpers.Mining.mine (`Hash head4) b1 [] >>=? fun fork -> Helpers.Mining.mine (`Hash hash5) b1 [] >>=? fun hash6b ->
Helpers.display_level (`Hash fork) >>=? fun () -> Helpers.display_level (`Hash hash6b) >>=? fun () ->
(* working on head *) (* working on head *)
Helpers.Endorse.endorsers_list (`Hash head) baccounts >>=? fun accounts -> Helpers.Endorse.endorsers_list (`Hash hash6a) >>=? fun accounts ->
get_endorser_except [ b1 ] accounts >>=? fun (account3, slot3) -> get_endorser_except [ b1 ] accounts >>=? fun (account3, slot3) ->
Helpers.Account.balance ~block:(`Hash head) account3 >>=? fun balance3 -> Helpers.Account.balance ~block:(`Hash hash6a) account3 >>=? fun balance3 ->
Helpers.Endorse.endorse Helpers.Endorse.endorse
~slot:slot3 account3 (`Hash head) >>=? fun ops -> ~slot:slot3 account3 (`Hash hash6a) >>=? fun ops ->
Helpers.Mining.mine (`Hash head) b1 [ ops ] >>=? fun new_head -> Helpers.Mining.mine (`Hash hash6a) b1 [ ops ] >>=? fun hash7a ->
Helpers.display_level (`Hash new_head) >>=? fun () -> Helpers.display_level (`Hash hash7a) >>=? fun () ->
(* working on fork *) (* working on fork *)
Helpers.Endorse.endorsers_list (`Hash fork) baccounts >>=? fun accounts -> Helpers.Endorse.endorsers_list (`Hash hash6b) >>=? fun accounts ->
get_endorser_except [ b1 ] accounts >>=? fun (account4, slot4) -> get_endorser_except [ b1 ] accounts >>=? fun (account4, slot4) ->
Helpers.Account.balance ~block:(`Hash new_head) account4 >>=? fun _balance4 -> Helpers.Account.balance ~block:(`Hash hash7a) account4 >>=? fun _balance4 ->
Helpers.Endorse.endorse ~slot:slot4 account4 (`Hash fork) >>=? fun ops -> Helpers.Endorse.endorse ~slot:slot4 account4 (`Hash hash6b) >>=? fun ops ->
Helpers.Mining.mine (`Hash fork) b1 [ ops ] >>=? fun _new_fork -> Helpers.Mining.mine (`Hash hash6b) b1 [ ops ] >>=? fun _new_fork ->
Helpers.display_level (`Hash _new_fork) >>=? fun () -> Helpers.display_level (`Hash _new_fork) >>=? fun () ->
Helpers.Account.balance ~block:(`Hash new_head) account4 >>=? fun balance4 -> Helpers.Account.balance ~block:(`Hash hash7a) account4 >>=? fun balance4 ->
Helpers.Mining.mine (`Hash new_head) b1 [] >>=? fun head -> Helpers.Mining.mine (`Hash hash7a) b1 [] >>=? fun hash8a ->
Helpers.display_level (`Hash head) >>=? fun () -> Helpers.display_level (`Hash hash8a) >>=? fun () ->
Helpers.Mining.mine (`Hash head) b1 [] >>=? fun head -> Helpers.Mining.mine (`Hash hash8a) b1 [] >>=? fun hash9a ->
Helpers.display_level (`Hash head) >>=? fun () -> Helpers.display_level (`Hash hash9a) >>=? fun () ->
(* Check rewards after one cycle *) (* Check rewards after one cycle *)
Helpers.Mining.endorsement_reward (`Hash new_head) >>=? fun reward -> Helpers.Mining.endorsement_reward (`Hash hash7a) >>=? fun reward ->
Assert.balance_equal ~block:(`Hash head) ~msg:__LOC__ account3 Assert.balance_equal ~block:(`Hash hash9a) ~msg:__LOC__ account3
(Int64.add (Tez.to_cents balance3) reward) >>=? fun () -> (Int64.add (Tez.to_cents balance3) reward) >>=? fun () ->
(* Check no reward for the fork *) (* Check no reward for the fork *)
@ -185,57 +189,60 @@ let test_endorsement_rewards
if account3 = account4 then return () if account3 = account4 then return ()
(* if account4 is different from account3, we need to check that there (* 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 *) is no reward for him since the endorsement was in the fork branch *)
else Assert.balance_equal ~block:(`Hash head) ~msg:__LOC__ account4 (Tez.to_cents balance4) else Assert.balance_equal ~block:(`Hash hash9a) ~msg:__LOC__ account4 (Tez.to_cents balance4)
end >>=? fun () -> end >>=? fun () ->
return head return ()
let test_endorsement_rights contract block = let test_endorsement_rights contract block =
Helpers.Endorse.endorsement_rights contract block >>|? fun possibilities -> Helpers.Endorse.endorsement_rights contract block >>|? fun possibilities ->
possibilities <> [] possibilities <> []
let run head (({ b1 ; b2 ; b3 ; b4 ; b5 } : Helpers.Account.bootstrap_accounts) as baccounts) = let run genesis =
let default_account = Helpers.Account.create "default_account" in test_endorsement_rights
default_account genesis >>=? fun has_right_to_endorse ->
test_endorsement_rights default_account head >>=? fun has_right_to_endorse ->
Assert.equal_bool ~msg:__LOC__ has_right_to_endorse false ; Assert.equal_bool ~msg:__LOC__ has_right_to_endorse false ;
test_endorsement_rights b1 head >>=? fun has_right_to_endorse -> test_endorsement_rights b1 genesis >>=? fun has_right_to_endorse ->
Assert.equal_bool ~msg:__LOC__ has_right_to_endorse true ; Assert.equal_bool ~msg:__LOC__ has_right_to_endorse true ;
test_endorsement_rights b1 head >>=? fun has_right_to_endorse -> test_endorsement_rights b1 genesis >>=? fun has_right_to_endorse ->
Assert.equal_bool ~msg:__LOC__ has_right_to_endorse true ; Assert.equal_bool ~msg:__LOC__ has_right_to_endorse true ;
Assert.balance_equal ~block:head ~msg:__LOC__ b1 4_000_000_00L >>=? fun () -> Assert.balance_equal
Assert.balance_equal ~block:head ~msg:__LOC__ b2 4_000_000_00L >>=? fun () -> ~block:genesis ~msg:__LOC__ b1 4_000_000_00L >>=? fun () ->
Assert.balance_equal ~block:head ~msg:__LOC__ b3 4_000_000_00L >>=? fun () -> Assert.balance_equal
Assert.balance_equal ~block:head ~msg:__LOC__ b4 4_000_000_00L >>=? fun () -> ~block:genesis ~msg:__LOC__ b2 4_000_000_00L >>=? fun () ->
Assert.balance_equal ~block:head ~msg:__LOC__ b5 4_000_000_00L >>=? fun () -> Assert.balance_equal
~block:genesis ~msg:__LOC__ b3 4_000_000_00L >>=? fun () ->
Assert.balance_equal
~block:genesis ~msg:__LOC__ b4 4_000_000_00L >>=? fun () ->
Assert.balance_equal
~block:genesis ~msg:__LOC__ b5 4_000_000_00L >>=? fun () ->
(* Check Rewards *) (* Check Rewards *)
test_endorsement_rewards head baccounts >>=? fun head -> test_endorsement_rewards genesis >>=? fun () ->
(* Endorse with a contract with wrong delegate: (* Endorse with a contract with wrong delegate:
- contract with no endorsement rights - contract with no endorsement rights
- contract which signs at every available slots *) - contract which signs at every available slots *)
test_wrong_delegate ~miner:b1 default_account head >>= fun () -> test_wrong_delegate ~miner:b1 default_account genesis >>= fun () ->
test_wrong_delegate ~miner:b1 b5 head >>= fun () -> test_wrong_delegate ~miner:b1 b5 genesis >>= fun () ->
(* Endorse with a wrong slot : -1 and max (16) *) (* Endorse with a wrong slot : -1 and max (16) *)
test_invalid_endorsement_slot b3 (`Hash head) >>=? fun () -> test_invalid_endorsement_slot b3 genesis >>=? fun () ->
(* FIXME: Mining.Invalid_signature is still unclassified *) (* FIXME: Mining.Invalid_signature is still unclassified *)
test_invalid_signature (`Hash head) >>=? fun _ -> test_invalid_signature genesis >>=? fun _ ->
(* FIXME: cannot inject double endorsement operation yet, but the (* FIXME: cannot inject double endorsement operation yet, but the
code is still here code is still here
Double endorsement *) Double endorsement *)
test_double_endorsement b4 (`Hash head) >>=? fun new_head -> test_double_endorsement b4 genesis >>=? fun _ ->
return new_head return ()
let main () = let main () =
Helpers.init () >>=? fun (_node_pid, hash) -> Helpers.init () >>=? fun (_node_pid, genesis) ->
run (`Hash hash) Helpers.Account.bootstrap_accounts >>=? fun _blkh -> run (`Hash genesis)
return ()
let tests = [ let tests = [

2
test/shell/test_state.ml
View File

@ -54,7 +54,7 @@ let incr_timestamp timestamp =
let operation op = let operation op =
let op : Operation.t = { let op : Operation.t = {
shell = { net_id } ; shell = { net_id ; branch = genesis_block } ;
proto = MBytes.of_string op ; proto = MBytes.of_string op ;
} in } in
Operation.hash op, Operation.hash op,

2
test/shell/test_store.ml
View File

@ -63,7 +63,7 @@ let net_id = Net_id.of_block_hash genesis_block
(** Operation store *) (** Operation store *)
let make proto : Tezos_data.Operation.t = let make proto : Tezos_data.Operation.t =
{ shell = { net_id } ; proto } { shell = { net_id ; branch = genesis_block } ; proto }
let op1 = make (MBytes.of_string "Capadoce") let op1 = make (MBytes.of_string "Capadoce")
let oph1 = Tezos_data.Operation.hash op1 let oph1 = Tezos_data.Operation.hash op1