ligo/src/proto_alpha/lib_baking/client_baking_blocks.ml
2018-06-06 15:24:05 +02:00

76 lines
3.1 KiB
OCaml

(**************************************************************************)
(* *)
(* 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
type block_info = {
hash: Block_hash.t ;
chain_id: Chain_id.t ;
predecessor: Block_hash.t ;
fitness: MBytes.t list ;
timestamp: Time.t ;
protocol: Protocol_hash.t ;
next_protocol: Protocol_hash.t ;
level: Level.t ;
}
let raw_info cctxt ?(chain = `Main) hash header =
let block = `Hash (hash, 0) in
Shell_services.Chain.chain_id cctxt ~chain () >>=? fun chain_id ->
Shell_services.Blocks.protocols
cctxt ~chain ~block () >>=? fun { current_protocol = protocol ;
next_protocol } ->
Alpha_block_services.metadata cctxt
~chain ~block () >>=? fun { protocol_data = { level } } ->
let { Tezos_base.Block_header.predecessor ; fitness ; timestamp ; _ } =
header.Tezos_base.Block_header.shell in
return { hash ; chain_id ; predecessor ; fitness ;
timestamp ; protocol ; next_protocol ; level }
let info cctxt ?(chain = `Main) block =
Shell_services.Blocks.hash cctxt ~chain ~block () >>=? fun hash ->
Shell_services.Blocks.Header.shell_header
cctxt ~chain ~block () >>=? fun shell ->
Shell_services.Blocks.Header.raw_protocol_data
cctxt ~chain ~block () >>=? fun protocol_data ->
raw_info cctxt ~chain hash { shell ; protocol_data }
let monitor_valid_blocks cctxt ?chains ?protocols ?next_protocols () =
Shell_services.Monitor.valid_blocks cctxt
?chains ?protocols ?next_protocols () >>=? fun (block_stream, _stop) ->
return (Lwt_stream.map_s
(fun ((chain, block), header) ->
raw_info cctxt ~chain:(`Hash chain) block header)
block_stream)
let monitor_heads cctxt ?next_protocols chain =
Monitor_services.heads
cctxt ?next_protocols chain >>=? fun (block_stream, _stop) ->
return (Lwt_stream.map_s
(fun (block, header) -> raw_info cctxt ~chain block header)
block_stream)
let blocks_from_current_cycle cctxt ?(chain = `Main) block ?(offset = 0l) () =
Shell_services.Blocks.hash cctxt ~chain ~block () >>=? fun hash ->
Alpha_block_services.metadata
cctxt ~chain ~block () >>=? fun { protocol_data = { level } } ->
Alpha_services.Helpers.levels_in_current_cycle
cctxt ~offset (chain, block) >>=? fun (first, last) ->
let length = Int32.to_int (Raw_level.diff level.level first) in
Shell_services.Blocks.list cctxt ~heads:[hash] ~length () >>=? fun blocks ->
let blocks =
List.remove
(length - (Int32.to_int (Raw_level.diff last first)))
(List.hd blocks) in
if Raw_level.(level.level = last) then
return (hash :: blocks)
else
return blocks