(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* Copyright (c) 2018-2021 Nomadic Labs, <contact@nomadic-labs.com> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
open Chain_services
let get_chain_id store =
let open Lwt_syntax in
let main_chain_store = Store.main_chain_store store in
function
| `Main -> Lwt.return (Store.Chain.chain_id main_chain_store)
| `Test ->
let* testchain = Store.Chain.testchain main_chain_store in
let testchain = WithExceptions.Option.to_exn ~none:Not_found testchain in
let testchain_store = Store.Chain.testchain_store testchain in
Lwt.return (Store.Chain.chain_id testchain_store)
| `Hash chain_id -> Lwt.return chain_id
let get_chain_id_opt store chain =
Option.catch_s (fun () -> get_chain_id store chain)
let get_chain_store_exn store chain =
let open Lwt_syntax in
let* chain_id = get_chain_id store chain in
let* chain_store = Store.get_chain_store_opt store chain_id in
let chain_store = WithExceptions.Option.to_exn ~none:Not_found chain_store in
Lwt.return chain_store
let get_checkpoint store (chain : Chain_services.chain) =
let open Lwt_syntax in
let* chain_store = get_chain_store_exn store chain in
let* checkpoint_hash, _ = Store.Chain.checkpoint chain_store in
Lwt.return checkpoint_hash
let predecessors chain_store ignored length head =
let open Lwt_result_syntax in
let rec loop acc length block =
if length <= 0 then return (List.rev acc)
else
let* o = Store.Block.read_ancestor_hash chain_store ~distance:1 block in
match o with
| None -> return (List.rev acc)
| Some pred ->
if Block_hash.Set.mem block ignored then return (List.rev acc)
else loop (pred :: acc) (length - 1) pred
in
let head_hash = Store.Block.hash head in
loop [head_hash] (length - 1) head_hash
let list_blocks chain_store ?(length = 1) ?min_date blocks =
let open Lwt_result_syntax in
let*! requested_blocks =
match blocks with
| [] ->
let*! head = Store.Chain.current_head chain_store in
Lwt.return [head]
| blocks ->
let*! blocks =
List.filter_map_p (Store.Block.read_block_opt chain_store) blocks
in
let blocks =
match min_date with
| None -> blocks
| Some min_date ->
List.filter
(fun block ->
let timestamp = Store.Block.timestamp block in
Time.Protocol.(min_date <= timestamp))
blocks
in
let sorted_blocks =
List.sort
(fun b1 b2 ->
let f1 = Store.Block.fitness b1 in
let f2 = Store.Block.fitness b2 in
~-(Fitness.compare f1 f2))
blocks
in
Lwt.return sorted_blocks
in
let* _, blocks =
List.fold_left_es
(fun (ignored, acc) block ->
let* predecessors = predecessors chain_store ignored length block in
let ignored =
List.fold_left
(fun acc v -> Block_hash.Set.add v acc)
ignored
predecessors
in
return (ignored, predecessors :: acc))
(Block_hash.Set.empty, [])
requested_blocks
in
return (List.rev blocks)
let rpc_directory validator =
let open Lwt_result_syntax in
let dir : Store.chain_store Tezos_rpc.Directory.t ref =
ref Tezos_rpc.Directory.empty
in
let register0 s f =
dir :=
Tezos_rpc.Directory.register
!dir
(Tezos_rpc.Service.subst0 s)
(fun chain p q -> f chain p q)
in
let register1 s f =
dir :=
Tezos_rpc.Directory.register
!dir
(Tezos_rpc.Service.subst1 s)
(fun (chain, a) p q -> f chain a p q)
in
let register_dynamic_directory2 ?descr s f =
dir :=
Tezos_rpc.Directory.register_dynamic_directory
!dir
?descr
(Tezos_rpc.Path.subst1 s)
(fun (chain, a) -> f chain a)
in
register0 S.chain_id (fun chain_store () () ->
return (Store.Chain.chain_id chain_store)) ;
register0 S.checkpoint (fun chain_store () () ->
let*! checkpoint_hash, _ = Store.Chain.checkpoint chain_store in
let* block = Store.Block.read_block chain_store checkpoint_hash in
let checkpoint_header = Store.Block.header block in
let*! _, savepoint_level = Store.Chain.savepoint chain_store in
let*! _, caboose_level = Store.Chain.caboose chain_store in
let history_mode = Store.Chain.history_mode chain_store in
return (checkpoint_header, savepoint_level, caboose_level, history_mode)) ;
register0 S.Levels.checkpoint (fun chain_store () () ->
let*! v = Store.Chain.checkpoint chain_store in
return v) ;
register0 S.Levels.savepoint (fun chain_store () () ->
let*! v = Store.Chain.savepoint chain_store in
return v) ;
register0 S.Levels.caboose (fun chain_store () () ->
let*! v = Store.Chain.caboose chain_store in
return v) ;
register0 S.is_bootstrapped (fun chain_store () () ->
match Validator.get validator (Store.Chain.chain_id chain_store) with
| Error _ -> Lwt.fail Not_found
| Ok chain_validator ->
return
Chain_validator.
(is_bootstrapped chain_validator, sync_status chain_validator)) ;
register0 S.force_bootstrapped (fun chain_store () b ->
match Validator.get validator (Store.Chain.chain_id chain_store) with
| Error _ -> Lwt.fail Not_found
| Ok chain_validator ->
let*! v = Chain_validator.force_bootstrapped chain_validator b in
return v) ;
(* blocks *)
register0 S.Blocks.list (fun chain q () ->
list_blocks chain ?length:q#length ?min_date:q#min_date q#heads) ;
register_dynamic_directory2
Block_services.path
Block_directory.build_rpc_directory ;
(* invalid_blocks *)
register0 S.Invalid_blocks.list (fun chain_store () () ->
let convert (hash, {Store_types.level; errors}) = {hash; level; errors} in
let*! invalid_blocks_map = Store.Block.read_invalid_blocks chain_store in
let blocks = Block_hash.Map.bindings invalid_blocks_map in
return (List.map convert blocks)) ;
register1 S.Invalid_blocks.get (fun chain_store hash () () ->
let*! o = Store.Block.read_invalid_block_opt chain_store hash in
match o with
| None -> Lwt.fail Not_found
| Some {level; errors} -> return {hash; level; errors}) ;
register1 S.Invalid_blocks.delete (fun chain_store hash () () ->
Store.Block.unmark_invalid chain_store hash) ;
!dir
let build_rpc_directory validator =
let distributed_db = Validator.distributed_db validator in
let store = Distributed_db.store distributed_db in
let dir = ref (rpc_directory validator) in
(* Mempool *)
let merge d = dir := Tezos_rpc.Directory.merge !dir d in
merge
(Tezos_rpc.Directory.map
(fun chain_store ->
match Validator.get validator (Store.Chain.chain_id chain_store) with
| Error _ -> Lwt.fail Not_found
| Ok chain_validator ->
Lwt.return (Chain_validator.prevalidator chain_validator))
Prevalidator.rpc_directory) ;
Tezos_rpc.Directory.prefix Chain_services.path
@@ Tezos_rpc.Directory.map
(fun ((), chain) -> get_chain_store_exn store chain)
!dir