Source file chain_services.ml

(*****************************************************************************)
(*                                                                           *)
(* 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 Data_encoding

type chain = [`Main | `Test | `Hash of Chain_id.t]

let chain_arg = Block_services.chain_arg

let to_string = Block_services.chain_to_string

let parse_chain = Block_services.parse_chain

type invalid_block = {hash : Block_hash.t; level : Int32.t; errors : error list}

type prefix = Block_services.chain_prefix

let path = Block_services.chain_path

let checkpoint_encoding =
  obj4
    (req "block" (dynamic_size Block_header.encoding))
    (req "savepoint" int32)
    (req "caboose" int32)
    (req "history_mode" History_mode.encoding)

let block_descriptor_encoding =
  obj2 (req "block_hash" Block_hash.encoding) (req "level" int32)

let invalid_block_encoding =
  conv
    (fun {hash; level; errors} -> (hash, level, errors))
    (fun (hash, level, errors) -> {hash; level; errors})
    (obj3
       (req "block" Block_hash.encoding)
       (req "level" int32)
       (req "errors" Tezos_rpc.Error.encoding))

let bootstrap_encoding =
  obj2
    (req "bootstrapped" Encoding.bool)
    (req "sync_state" Chain_validator_worker_state.sync_status_encoding)

module S = struct
  let path : prefix Tezos_rpc.Path.context = Tezos_rpc.Path.open_root

  let chain_id =
    Tezos_rpc.Service.get_service
      ~description:"The chain unique identifier."
      ~query:Tezos_rpc.Query.empty
      ~output:Chain_id.encoding
      Tezos_rpc.Path.(path / "chain_id")

  (* DEPRECATED: use `chains/<CHAIN_ID>/levels/{checkpoint, savepoint,
     caboose, history_mode}` instead. *)
  let checkpoint =
    Tezos_rpc.Service.get_service
      ~description:
        "DEPRECATED: use `../levels/{checkpoint, savepoint, caboose, \
         history_mode}` instead. The current checkpoint for this chain."
      ~query:Tezos_rpc.Query.empty
      ~output:checkpoint_encoding
      Tezos_rpc.Path.(path / "checkpoint")

  let is_bootstrapped =
    Tezos_rpc.Service.get_service
      ~description:"The bootstrap status of a chain"
      ~query:Tezos_rpc.Query.empty
      ~output:bootstrap_encoding
      Tezos_rpc.Path.(path / "is_bootstrapped")

  let bootstrapped_flag_encoding =
    let open Data_encoding in
    obj1 (req "bootstrapped" bool)

  let force_bootstrapped =
    Tezos_rpc.Service.patch_service
      ~description:"Forcefully set the bootstrapped flag of the node"
      ~query:Tezos_rpc.Query.empty
      ~input:bootstrapped_flag_encoding
      ~output:unit
      path

  module Levels = struct
    let path = Tezos_rpc.Path.(path / "levels")

    let checkpoint =
      Tezos_rpc.Service.get_service
        ~description:"The current checkpoint for this chain."
        ~query:Tezos_rpc.Query.empty
        ~output:block_descriptor_encoding
        Tezos_rpc.Path.(path / "checkpoint")

    let savepoint =
      Tezos_rpc.Service.get_service
        ~description:"The current savepoint for this chain."
        ~query:Tezos_rpc.Query.empty
        ~output:block_descriptor_encoding
        Tezos_rpc.Path.(path / "savepoint")

    let caboose =
      Tezos_rpc.Service.get_service
        ~description:"The current caboose for this chain."
        ~query:Tezos_rpc.Query.empty
        ~output:block_descriptor_encoding
        Tezos_rpc.Path.(path / "caboose")
  end

  module Blocks = struct
    let list_query =
      let open Tezos_rpc.Query in
      query (fun length heads min_date ->
          object
            method length = length

            method heads = heads

            method min_date = min_date
          end)
      |+ opt_field
           "length"
           ~descr:
             "The requested number of predecessors to return (per request; see \
              next argument)."
           Tezos_rpc.Arg.uint
           (fun x -> x#length)
      |+ multi_field
           "head"
           ~descr:
             "An empty argument requests blocks starting with the current \
              head. A non empty list allows to request one or more specific \
              fragments of the chain."
           Block_hash.rpc_arg
           (fun x -> x#heads)
      |+ opt_field
           "min_date"
           ~descr:
             "When `min_date` is provided, blocks with a timestamp before \
              `min_date` are filtered out. However, if the `length` parameter \
              is also provided, then up to that number of predecessors will be \
              returned regardless of their date."
           Time.Protocol.rpc_arg
           (fun x -> x#min_date)
      |> seal

    let path = Tezos_rpc.Path.(path / "blocks")

    let list =
      let open Data_encoding in
      Tezos_rpc.Service.get_service
        ~description:
          "Lists block hashes from '<chain>', up to the last checkpoint, \
           sorted with decreasing fitness. Without arguments it returns the \
           head of the chain. Optional arguments allow to return the list of \
           predecessors of a given block or of a set of blocks."
        ~query:list_query
        ~output:(list (list Block_hash.encoding))
        path
  end

  module Invalid_blocks = struct
    let path = Tezos_rpc.Path.(path / "invalid_blocks")

    let list =
      Tezos_rpc.Service.get_service
        ~description:
          "Lists blocks that have been declared invalid along with the errors \
           that led to them being declared invalid."
        ~query:Tezos_rpc.Query.empty
        ~output:(list invalid_block_encoding)
        path

    let get =
      Tezos_rpc.Service.get_service
        ~description:"The errors that appears during the block (in)validation."
        ~query:Tezos_rpc.Query.empty
        ~output:invalid_block_encoding
        Tezos_rpc.Path.(path /: Block_hash.rpc_arg)

    let delete =
      Tezos_rpc.Service.delete_service
        ~description:"Remove an invalid block for the tezos storage"
        ~query:Tezos_rpc.Query.empty
        ~output:Data_encoding.empty
        Tezos_rpc.Path.(path /: Block_hash.rpc_arg)
  end
end

let make_call0 s ctxt chain q p =
  let s = Tezos_rpc.Service.prefix path s in
  Tezos_rpc.Context.make_call1 s ctxt chain q p

let make_call1 s ctxt chain a q p =
  let s = Tezos_rpc.Service.prefix path s in
  Tezos_rpc.Context.make_call2 s ctxt chain a q p

let chain_id ctxt =
  let f = make_call0 S.chain_id ctxt in
  fun ?(chain = `Main) () ->
    match chain with `Hash h -> Lwt.return_ok h | _ -> f chain () ()

let checkpoint ctxt ?(chain = `Main) () =
  make_call0 S.checkpoint ctxt chain () ()

module Levels = struct
  let checkpoint ctxt ?(chain = `Main) () =
    make_call0 S.Levels.checkpoint ctxt chain () ()

  let savepoint ctxt ?(chain = `Main) () =
    make_call0 S.Levels.savepoint ctxt chain () ()

  let caboose ctxt ?(chain = `Main) () =
    make_call0 S.Levels.caboose ctxt chain () ()
end

module Blocks = struct
  let list ctxt =
    let f = make_call0 S.Blocks.list ctxt in
    fun ?(chain = `Main) ?(heads = []) ?length ?min_date () ->
      f
        chain
        (object
           method heads = heads

           method length = length

           method min_date = min_date
        end)
        ()

  include Block_services.Empty

  type protocols = Block_services.protocols = {
    current_protocol : Protocol_hash.t;
    next_protocol : Protocol_hash.t;
  }

  let protocols = Block_services.protocols
end

module Mempool = Block_services.Empty.Mempool

module Invalid_blocks = struct
  let list ctxt =
    let f = make_call0 S.Invalid_blocks.list ctxt in
    fun ?(chain = `Main) () -> f chain () ()

  let get ctxt =
    let f = make_call1 S.Invalid_blocks.get ctxt in
    fun ?(chain = `Main) block -> f chain block () ()

  let delete ctxt =
    let f = make_call1 S.Invalid_blocks.delete ctxt in
    fun ?(chain = `Main) block -> f chain block () ()
end