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

Getting the block_header out of contents in Store (no change in State interface)

Browse Source
This commit is contained in:
Thomas Blanc 2018-08-27 17:28:55 +02:00 committed by Grégoire Henry
parent ebaa3e49f6
commit c723869f65
4 changed files with 145 additions and 105 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

118
src/lib_shell/state.ml
View File

@ -91,6 +91,7 @@ and block = {
chain_state: chain_state ;
hash: Block_hash.t ;
contents: Store.Block.contents ;
header: Block_header.t ;
}
let read_chain_data { chain_data } f =
@ -147,8 +148,8 @@ let store_predecessors (store: Store.Block.store) (b: Block_hash.t) : unit Lwt.t
loop p (dist+1)
in
(* the first predecessor is fetched from the header *)
Store.Block.Contents.read_exn (store, b) >>= fun contents ->
let pred = contents.header.shell.predecessor in
Store.Block.Header.read_exn (store, b) >>= fun header ->
let pred = header.shell.predecessor in
if Block_hash.equal b pred then
Lwt.return_unit (* genesis *)
else
@ -216,7 +217,7 @@ let predecessor_n (store: Store.Block.store) (block_hash: Block_hash.t) (distanc
let compute_locator_from_hash (chain : chain_state) ?(size = 200) head_hash seed =
Shared.use chain.block_store begin fun block_store ->
Store.Block.Contents.read_exn (block_store, head_hash) >>= fun { header } ->
Store.Block.Header.read_exn (block_store, head_hash) >>= fun header ->
Block_locator.compute ~predecessor:(predecessor_n block_store)
~genesis:chain.genesis.block head_hash header seed ~size
end
@ -240,8 +241,9 @@ module Locked_block = struct
context ;
} in
let header : Block_header.t = { shell ; protocol_data = MBytes.create 0 } in
Store.Block.Header.store (store, genesis.block) header >>= fun () ->
Store.Block.Contents.store (store, genesis.block)
{ Store.Block.header ; message = Some "Genesis" ;
{ Store.Block.message = Some "Genesis" ;
max_operations_ttl = 0 ; context ;
metadata = MBytes.create 0 ;
last_allowed_fork_level = 0l ;
@ -259,7 +261,7 @@ module Locked_block = struct
else (* header.shell.level < level *)
(* valid only if the current head is lower than the checkpoint. *)
let head_level =
chain_data.data.current_head.contents.header.shell.level in
chain_data.data.current_head.header.shell.level in
Lwt.return (head_level < level)
(* Is a block still valid for a given checkpoint ? *)
@ -288,8 +290,8 @@ let locked_valid_heads_for_checkpoint block_store data checkpoint =
Block_hash.Set.fold
(fun head acc ->
let valid_header =
Store.Block.Contents.read_exn
(block_store, head) >>= fun { header } ->
Store.Block.Header.read_exn
(block_store, head) >>= fun header ->
Locked_block.is_valid_for_checkpoint
block_store head header checkpoint >>= fun valid ->
Lwt.return (valid, header) in
@ -318,11 +320,11 @@ let tag_invalid_heads block_store chain_store heads level =
Store.Block.Operation_path.remove_all (block_store, hash) >>= fun () ->
Store.Block.Operations.remove_all (block_store, hash) >>= fun () ->
Store.Block.Predecessors.remove_all (block_store, hash) >>= fun () ->
Store.Block.Contents.read_opt
Store.Block.Header.read_opt
(block_store, header.shell.predecessor) >>= function
| None ->
Lwt.return_none
| Some { header } ->
| Some header ->
tag_invalid_head (Block_header.hash header, header) in
Lwt_list.iter_p
(fun (hash, _header) ->
@ -342,11 +344,11 @@ let cut_alternate_heads block_store chain_store heads =
Store.Block.Operation_path.remove_all (block_store, hash) >>= fun () ->
Store.Block.Operations.remove_all (block_store, hash) >>= fun () ->
Store.Block.Predecessors.remove_all (block_store, hash) >>= fun () ->
Store.Block.Contents.read_opt
Store.Block.Header.read_opt
(block_store, header.Block_header.shell.predecessor) >>= function
| None ->
Lwt.return_unit
| Some { header } ->
| Some header ->
cut_alternate_head (Block_header.hash header) header in
Lwt_list.iter_p
(fun (hash, header) ->
@ -386,12 +388,15 @@ module Chain = struct
global_state context_index chain_data_store block_store =
Store.Block.Contents.read_exn
(block_store, current_head) >>= fun current_block ->
Store.Block.Header.read_exn
(block_store, current_head) >>= fun current_block_head ->
let rec chain_data = {
data = {
current_head = {
chain_state ;
hash = current_head ;
contents = current_block ;
header = current_block_head ;
} ;
current_mempool = Mempool.empty ;
live_blocks = Block_hash.Set.singleton genesis.block ;
@ -480,14 +485,14 @@ module Chain = struct
Store.Chain.Expiration.read_opt chain_store >>= fun expiration ->
Store.Chain.Allow_forked_chain.known
data.global_store id >>= fun allow_forked_chain ->
Store.Block.Contents.read (block_store, genesis_hash) >>=? fun genesis_header ->
Store.Block.Header.read (block_store, genesis_hash) >>=? fun genesis_header ->
let genesis = { time ; protocol ; block = genesis_hash } in
Store.Chain_data.Current_head.read chain_data_store >>=? fun current_head ->
Store.Chain_data.Checkpoint.read chain_data_store >>=? fun checkpoint ->
try
allocate
~genesis
~faked_genesis_hash:(Block_header.hash genesis_header.header)
~faked_genesis_hash:(Block_header.hash genesis_header)
~current_head
~expiration
~allow_forked_chain
@ -546,7 +551,7 @@ module Chain = struct
Shared.use chain_state.block_store begin fun store ->
Shared.use chain_state.chain_data begin fun data ->
let head_header =
data.data.current_head.contents.header in
data.data.current_head.header in
let head_hash = data.data.current_head.hash in
Locked_block.is_valid_for_checkpoint
store head_hash head_header checkpoint >>= fun valid ->
@ -611,6 +616,7 @@ module Block = struct
chain_state: Chain.t ;
hash: Block_hash.t ;
contents: Store.Block.contents ;
header: Block_header.t ;
}
type block = t
@ -618,11 +624,11 @@ module Block = struct
let equal b1 b2 = Block_hash.equal b1.hash b2.hash
let hash { hash } = hash
let header { contents = { header } } = header
let header { header } = header
let metadata { contents = { metadata } } = metadata
let chain_state { chain_state } = chain_state
let chain_id { chain_state = { chain_id } } = chain_id
let shell_header { contents = { header = { shell } } } = shell
let shell_header { header = { shell } } = shell
let timestamp b = (shell_header b).timestamp
let fitness b = (shell_header b).fitness
let level b = (shell_header b).level
@ -666,7 +672,7 @@ module Block = struct
let chain_state = block.chain_state in
Shared.use chain_state.block_store begin fun store ->
Locked_block.is_valid_for_checkpoint
store block.hash block.contents.header checkpoint
store block.hash block.header checkpoint
end
let known chain_state hash =
@ -689,7 +695,8 @@ module Block = struct
| Some hash -> return hash
end >>=? fun hash ->
Store.Block.Contents.read (store, hash) >>=? fun contents ->
return { chain_state ; hash ; contents }
Store.Block.Header.read (store, hash) >>=? fun header ->
return { chain_state ; hash ; contents ; header }
end
let read_opt chain_state ?pred hash =
read chain_state ?pred hash >>= function
@ -706,22 +713,23 @@ module Block = struct
| Some hash -> Lwt.return hash
end >>= fun hash ->
Store.Block.Contents.read_exn (store, hash) >>= fun contents ->
Lwt.return { chain_state ; hash ; contents }
Store.Block.Header.read_exn (store, hash) >>= fun header ->
Lwt.return { chain_state ; hash ; contents ; header }
end
(* Quick accessor to be optimized ?? *)
let read_predecessor chain_state hash =
read chain_state hash >>=? fun { contents = { header } } ->
read chain_state hash >>=? fun { header } ->
return header.shell.predecessor
let read_predecessor_opt chain_state hash =
read_predecessor chain_state hash >>= function
| Error _ -> Lwt.return_none
| Ok v -> Lwt.return_some v
let read_predecessor_exn chain_state hash =
read_exn chain_state hash >>= fun { contents = { header } } ->
read_exn chain_state hash >>= fun { header } ->
Lwt.return header.shell.predecessor
let predecessor { chain_state ; contents = { header } ; hash } =
let predecessor { chain_state ; header ; hash } =
if Block_hash.equal hash header.shell.predecessor then
Lwt.return_none (* we are at genesis *)
else
@ -782,19 +790,21 @@ module Block = struct
(dont_enforce_context_hash
|| Context_hash.equal block_header.shell.context commit)
(Inconsistent_hash (commit, block_header.shell.context)) >>=? fun () ->
let contents = {
Store.Block.header =
let header =
if dont_enforce_context_hash then
{ block_header
with shell = { block_header.shell with context = commit } }
else
block_header ;
message ;
block_header
in
let contents = {
Store.Block.message ;
max_operations_ttl ;
last_allowed_fork_level ;
context = commit ;
metadata = block_header_metadata ;
} in
Store.Block.Header.store (store, hash) header >>= fun () ->
Store.Block.Contents.store (store, hash) contents >>= fun () ->
let hashes = List.map (List.map Operation.hash) operations in
let list_hashes = List.map Operation_list_hash.compute hashes in
@ -822,7 +832,7 @@ module Block = struct
Store.Chain_data.Known_heads.remove store predecessor >>= fun () ->
Store.Chain_data.Known_heads.store store hash
end >>= fun () ->
let block = { chain_state ; hash ; contents } in
let block = { chain_state ; hash ; contents ; header } in
Lwt_watcher.notify chain_state.block_watcher block ;
Lwt_watcher.notify chain_state.global_state.block_watcher block ;
return_some block
@ -847,8 +857,8 @@ module Block = struct
let watcher (state : chain_state) =
Lwt_watcher.create_stream state.block_watcher
let operation_hashes { chain_state ; hash ; contents } i =
if i < 0 || contents.header.shell.validation_passes <= i then
let operation_hashes { chain_state ; hash ; header } i =
if i < 0 || header.shell.validation_passes <= i then
invalid_arg "State.Block.operations" ;
Shared.use chain_state.block_store begin fun store ->
Store.Block.Operation_hashes.read_exn (store, hash) i >>= fun hashes ->
@ -856,15 +866,15 @@ module Block = struct
Lwt.return (hashes, path)
end
let all_operation_hashes { chain_state ; hash ; contents } =
let all_operation_hashes { chain_state ; hash ; header } =
Shared.use chain_state.block_store begin fun store ->
Lwt_list.map_p
(Store.Block.Operation_hashes.read_exn (store, hash))
(0 -- (contents.header.shell.validation_passes - 1))
(0 -- (header.shell.validation_passes - 1))
end
let operations { chain_state ; hash ; contents } i =
if i < 0 || contents.header.shell.validation_passes <= i then
let operations { chain_state ; hash ; header } i =
if i < 0 || header.shell.validation_passes <= i then
invalid_arg "State.Block.operations" ;
Shared.use chain_state.block_store begin fun store ->
Store.Block.Operation_path.read_exn (store, hash) i >>= fun path ->
@ -872,26 +882,26 @@ module Block = struct
Lwt.return (ops, path)
end
let operations_metadata { chain_state ; hash ; contents } i =
if i < 0 || contents.header.shell.validation_passes <= i then
let operations_metadata { chain_state ; hash ; header } i =
if i < 0 || header.shell.validation_passes <= i then
invalid_arg "State.Block.operations_metadata" ;
Shared.use chain_state.block_store begin fun store ->
Store.Block.Operations_metadata.read_exn (store, hash) i >>= fun ops ->
Lwt.return ops
end
let all_operations { chain_state ; hash ; contents } =
let all_operations { chain_state ; hash ; header } =
Shared.use chain_state.block_store begin fun store ->
Lwt_list.map_p
(fun i -> Store.Block.Operations.read_exn (store, hash) i)
(0 -- (contents.header.shell.validation_passes - 1))
(0 -- (header.shell.validation_passes - 1))
end
let all_operations_metadata { chain_state ; hash ; contents } =
let all_operations_metadata { chain_state ; hash ; header } =
Shared.use chain_state.block_store begin fun store ->
Lwt_list.map_p
(fun i -> Store.Block.Operations_metadata.read_exn (store, hash) i)
(0 -- (contents.header.shell.validation_passes - 1))
(0 -- (header.shell.validation_passes - 1))
end
let context { chain_state ; hash } =
@ -938,7 +948,7 @@ module Block = struct
Lwt.return_some (block, locator)
let get_rpc_directory ({ chain_state ; _ } as block) =
read_opt chain_state block.contents.header.shell.predecessor >>= function
read_opt chain_state block.header.shell.predecessor >>= function
| None -> Lwt.return_none (* genesis *)
| Some pred ->
protocol_hash pred >>= fun protocol ->
@ -952,7 +962,7 @@ module Block = struct
Lwt.return (Protocol_hash.Map.find_opt next_protocol map)
let set_rpc_directory ({ chain_state ; _ } as block) dir =
read_exn chain_state block.contents.header.shell.predecessor >>= fun pred ->
read_exn chain_state block.header.shell.predecessor >>= fun pred ->
protocol_hash block >>= fun next_protocol ->
protocol_hash pred >>= fun protocol ->
let map =
@ -994,11 +1004,11 @@ let fork_testchain block protocol expiration =
Context.set_test_chain context Not_running >>= fun context ->
Context.set_protocol context protocol >>= fun context ->
Context.commit_test_chain_genesis
data.context_index block.hash block.contents.header.shell.timestamp
data.context_index block.hash block.header.shell.timestamp
context >>=? fun (chain_id, genesis, commit) ->
let genesis = {
block = genesis ;
time = Time.add block.contents.header.shell.timestamp 1L ;
time = Time.add block.header.shell.timestamp 1L ;
protocol ;
} in
Chain.locked_create block.chain_state.global_state data
@ -1013,42 +1023,48 @@ let best_known_head_for_checkpoint chain_state (level, _ as checkpoint) =
Shared.use chain_state.block_store begin fun store ->
Shared.use chain_state.chain_data begin fun data ->
let head_hash = data.data.current_head.hash in
let head_header = data.data.current_head.contents.header in
let head_header = data.data.current_head.header in
Locked_block.is_valid_for_checkpoint
store head_hash head_header checkpoint >>= fun valid ->
if valid then
Lwt.return data.data.current_head
else
let find_valid_predecessor hash =
Store.Block.Header.read_exn
(store, hash) >>= fun header ->
if Compare.Int32.(header.shell.level < level) then
Store.Block.Contents.read_exn
(store, hash) >>= fun contents ->
if Compare.Int32.(contents.header.shell.level < level) then
Lwt.return { hash ; contents ; chain_state }
Lwt.return { hash ; contents ; chain_state ; header }
else
predecessor_n store hash
(1 + (Int32.to_int @@
Int32.sub contents.header.shell.level level)) >>= function
Int32.sub header.shell.level level)) >>= function
| None -> assert false
| Some pred ->
Store.Block.Contents.read_exn
(store, pred) >>= fun pred_contents ->
Store.Block.Header.read_exn
(store, pred) >>= fun pred_header ->
Lwt.return { hash = pred ; contents = pred_contents ;
chain_state } in
chain_state ; header = pred_header } in
Store.Chain_data.Known_heads.read_all
data.chain_data_store >>= fun heads ->
Store.Block.Contents.read_exn
(store, chain_state.genesis.block) >>= fun genesis_contents ->
Store.Block.Header.read_exn
(store, chain_state.genesis.block) >>= fun genesis_header ->
let genesis =
{ hash = chain_state.genesis.block ;
contents = genesis_contents ;
chain_state } in
chain_state ; header = genesis_header } in
Block_hash.Set.fold
(fun head best ->
let valid_predecessor = find_valid_predecessor head in
best >>= fun best ->
valid_predecessor >>= fun pred ->
if Fitness.(pred.contents.header.shell.fitness >
best.contents.header.shell.fitness) then
if Fitness.(pred.header.shell.fitness >
best.header.shell.fitness) then
Lwt.return pred
else
Lwt.return best)

20
src/lib_shell/store.ml
View File

@ -97,7 +97,6 @@ module Block = struct
(Block_hash)
type contents = {
header: Block_header.t ;
message: string option ;
max_operations_ttl: int ;
last_allowed_fork_level: Int32.t ;
@ -105,6 +104,12 @@ module Block = struct
metadata: MBytes.t ;
}
module Header =
Store_helpers.Make_single_store
(Indexed_store.Store)
(struct let name = ["header"] end)
(Store_helpers.Make_value(Block_header))
module Contents =
Store_helpers.Make_single_store
(Indexed_store.Store)
@ -114,23 +119,22 @@ module Block = struct
let encoding =
let open Data_encoding in
conv
(fun { header ; message ; max_operations_ttl ;
(fun { message ; max_operations_ttl ;
last_allowed_fork_level ;
context ; metadata } ->
(message, max_operations_ttl, last_allowed_fork_level,
context, metadata, header ))
context, metadata ))
(fun (message, max_operations_ttl, last_allowed_fork_level,
context, metadata, header ) ->
{ header ; message ; max_operations_ttl ;
context, metadata ) ->
{ message ; max_operations_ttl ;
last_allowed_fork_level ;
context ; metadata })
(obj6
(obj5
(opt "message" string)
(req "max_operations_ttl" uint16)
(req "last_allowed_fork_level" int32)
(req "context" Context_hash.encoding)
(req "metadata" bytes)
(req "header" Block_header.encoding))
(req "metadata" bytes))
end))
module Operations_index =

5
src/lib_shell/store.mli
View File

@ -106,7 +106,6 @@ module Block : sig
val get: Chain.store -> store
type contents = {
header: Block_header.t ;
message: string option ;
max_operations_ttl: int ;
last_allowed_fork_level: Int32.t ;
@ -114,6 +113,10 @@ module Block : sig
metadata: MBytes.t ;
}
module Header : SINGLE_STORE
with type t = store * Block_hash.t
and type value := Block_header.t
module Contents : SINGLE_STORE
with type t = store * Block_hash.t
and type value := contents

63
src/lib_shell/test/test_store.ml
View File

@ -93,8 +93,7 @@ let lolblock ?(operations = []) header =
let operations_hash =
Operation_list_list_hash.compute
[Operation_list_hash.compute operations] in
{ Store.Block.header =
{ Block_header.shell =
( { Block_header.shell =
{ timestamp = Time.of_seconds (Random.int64 1500L) ;
level = 0l ; (* dummy *)
proto_level = 0 ; (* dummy *)
@ -103,39 +102,50 @@ let lolblock ?(operations = []) header =
fitness = [MBytes.of_string @@ string_of_int @@ String.length header;
MBytes.of_string @@ string_of_int @@ 12] ;
context = Context_hash.zero } ;
protocol_data = MBytes.of_string header ;
} ;
metadata = MBytes.create 0 ;
protocol_data = MBytes.of_string header ; } ,
{ Store.Block.metadata = MBytes.create 0 ;
max_operations_ttl = 0 ;
message = None ;
context = Context_hash.zero ;
last_allowed_fork_level = 0l ;
}
} )
let b1 = lolblock "Blop !"
let bh1 = Block_header.hash b1.header
let b2 = lolblock "Tacatlopo"
let bh2 = Block_header.hash b2.header
let b3 = lolblock ~operations:[oph1;oph2] "Persil"
let bh3 = Block_header.hash b3.header
let (b1_header,b1_contents) as b1 = lolblock "Blop !"
let bh1 = Block_header.hash b1_header
let (b2_header,b2_contents) as b2 = lolblock "Tacatlopo"
let bh2 = Block_header.hash b2_header
let (b3_header,b3_contents) as b3 = lolblock ~operations:[oph1;oph2] "Persil"
let bh3 = Block_header.hash b3_header
let bh3' =
let raw = Bytes.of_string @@ Block_hash.to_string bh3 in
Bytes.set raw 31 '\000' ;
Bytes.set raw 30 '\000' ;
Block_hash.of_string_exn @@ Bytes.to_string raw
let equal (b1: Store.Block.contents) (b2: Store.Block.contents) =
Block_header.equal b1.header b2.header &&
b1.message = b2.message
let equal
(b1_header,b1_contents : Block_header.t * Store.Block.contents)
(b2_header,b2_contents : Block_header.t * Store.Block.contents) =
Block_header.equal b1_header b2_header &&
b1_contents.message = b2_contents.message
let check_block s h b =
Store.Block.Contents.read (s, h) >>= function
| Ok b' when equal b b' -> Lwt.return_unit
| Ok bc' ->
begin
Store.Block.Header.read (s, h) >>= function
| Ok bh' when equal b (bh',bc') ->
Lwt.return_unit
| Ok _ ->
Format.eprintf
"Error while reading block %a\n%!"
Block_hash.pp_short h ;
exit 1
| Error err ->
Format.eprintf "@[Error while reading block header %a:@ %a\n@]"
Block_hash.pp_short h
pp_print_error err ;
exit 1
end
| Error err ->
Format.eprintf "@[Error while reading block %a:@ %a\n@]"
Block_hash.pp_short h
@ -145,9 +155,12 @@ let check_block s h b =
let test_block s =
let s = Store.Chain.get s chain_id in
let s = Store.Block.get s in
Block.Contents.store (s, bh1) b1 >>= fun () ->
Block.Contents.store (s, bh2) b2 >>= fun () ->
Block.Contents.store (s, bh3) b3 >>= fun () ->
Block.Contents.store (s, bh1) b1_contents >>= fun () ->
Block.Contents.store (s, bh2) b2_contents >>= fun () ->
Block.Contents.store (s, bh3) b3_contents >>= fun () ->
Block.Header.store (s, bh1) b1_header >>= fun () ->
Block.Header.store (s, bh2) b2_header >>= fun () ->
Block.Header.store (s, bh3) b3_header >>= fun () ->
check_block s bh1 b1 >>= fun () ->
check_block s bh2 b2 >>= fun () ->
check_block s bh3 b3
@ -155,10 +168,14 @@ let test_block s =
let test_expand s =
let s = Store.Chain.get s chain_id in
let s = Store.Block.get s in
Block.Contents.store (s, bh1) b1 >>= fun () ->
Block.Contents.store (s, bh2) b2 >>= fun () ->
Block.Contents.store (s, bh3) b3 >>= fun () ->
Block.Contents.store (s, bh3') b3 >>= fun () ->
Block.Contents.store (s, bh1) b1_contents >>= fun () ->
Block.Contents.store (s, bh2) b2_contents >>= fun () ->
Block.Contents.store (s, bh3) b3_contents >>= fun () ->
Block.Contents.store (s, bh3') b3_contents >>= fun () ->
Block.Header.store (s, bh1) b1_header >>= fun () ->
Block.Header.store (s, bh2) b2_header >>= fun () ->
Block.Header.store (s, bh3) b3_header >>= fun () ->
Block.Header.store (s, bh3') b3_header >>= fun () ->
Base58.complete (Block_hash.to_short_b58check bh1) >>= fun res ->
Assert.equal_string_list ~msg:__LOC__ res [Block_hash.to_b58check bh1] ;
Base58.complete (Block_hash.to_short_b58check bh2) >>= fun res ->