2019-09-05 17:21:01 +04:00
|
|
|
(*****************************************************************************)
|
|
|
|
(* *)
|
|
|
|
(* Open Source License *)
|
|
|
|
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.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. *)
|
|
|
|
(* *)
|
|
|
|
(*****************************************************************************)
|
|
|
|
|
2019-10-17 13:45:27 +04:00
|
|
|
(** {1 Errors} *)
|
2019-09-05 17:21:01 +04:00
|
|
|
|
|
|
|
type error += Too_many_internal_operations (* `Permanent *)
|
|
|
|
|
|
|
|
(** An internal storage error that should not happen *)
|
|
|
|
type storage_error =
|
|
|
|
| Incompatible_protocol_version of string
|
|
|
|
| Missing_key of string list * [`Get | `Set | `Del | `Copy]
|
|
|
|
| Existing_key of string list
|
|
|
|
| Corrupted_data of string list
|
|
|
|
|
|
|
|
type error += Storage_error of storage_error
|
2020-02-12 20:40:17 +04:00
|
|
|
|
2019-09-05 17:21:01 +04:00
|
|
|
type error += Failed_to_parse_parameter of MBytes.t
|
2020-02-12 20:40:17 +04:00
|
|
|
|
2019-09-05 17:21:01 +04:00
|
|
|
type error += Failed_to_decode_parameter of Data_encoding.json * string
|
|
|
|
|
2020-02-12 20:40:17 +04:00
|
|
|
val storage_error : storage_error -> 'a tzresult Lwt.t
|
2019-09-05 17:21:01 +04:00
|
|
|
|
2019-10-17 13:45:27 +04:00
|
|
|
(** {1 Abstract Context} *)
|
2019-09-05 17:21:01 +04:00
|
|
|
|
|
|
|
(** Abstract view of the context.
|
|
|
|
Includes a handle to the functional key-value database
|
|
|
|
({!Context.t}) along with some in-memory values (gas, etc.). *)
|
2020-02-12 20:40:17 +04:00
|
|
|
|
2019-12-19 19:09:53 +04:00
|
|
|
module Int_set : sig
|
|
|
|
type t
|
|
|
|
end
|
|
|
|
type t = {
|
2020-02-12 20:40:17 +04:00
|
|
|
context : Context.t;
|
|
|
|
constants : Constants_repr.parametric;
|
|
|
|
first_level : Raw_level_repr.t;
|
|
|
|
level : Level_repr.t;
|
|
|
|
predecessor_timestamp : Time.t;
|
|
|
|
timestamp : Time.t;
|
|
|
|
fitness : Int64.t;
|
|
|
|
deposits : Tez_repr.t Signature.Public_key_hash.Map.t;
|
|
|
|
included_endorsements : int;
|
|
|
|
allowed_endorsements :
|
|
|
|
(Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t;
|
|
|
|
fees : Tez_repr.t;
|
|
|
|
rewards : Tez_repr.t;
|
|
|
|
block_gas : Z.t;
|
|
|
|
operation_gas : Gas_limit_repr.t;
|
|
|
|
internal_gas : Gas_limit_repr.internal_gas;
|
|
|
|
storage_space_to_pay : Z.t option;
|
|
|
|
allocated_contracts : int option;
|
|
|
|
origination_nonce : Contract_repr.origination_nonce option;
|
|
|
|
temporary_big_map : Z.t;
|
|
|
|
internal_nonce : int;
|
|
|
|
internal_nonces_used : Int_set.t;
|
2019-12-19 19:09:53 +04:00
|
|
|
}
|
|
|
|
|
2019-09-05 17:21:01 +04:00
|
|
|
type context = t
|
2020-02-12 20:40:17 +04:00
|
|
|
|
2019-09-05 17:21:01 +04:00
|
|
|
type root_context = t
|
|
|
|
|
|
|
|
(** Retrieves the state of the database and gives its abstract view.
|
|
|
|
It also returns wether this is the first block validated
|
|
|
|
with this version of the protocol. *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val prepare :
|
|
|
|
level:Int32.t ->
|
|
|
|
predecessor_timestamp:Time.t ->
|
|
|
|
timestamp:Time.t ->
|
|
|
|
fitness:Fitness.t ->
|
|
|
|
Context.t ->
|
|
|
|
context tzresult Lwt.t
|
|
|
|
|
|
|
|
type previous_protocol = Genesis of Parameters_repr.t | Babylon_005
|
|
|
|
|
|
|
|
val prepare_first_block :
|
2019-09-05 17:21:01 +04:00
|
|
|
level:int32 ->
|
|
|
|
timestamp:Time.t ->
|
|
|
|
fitness:Fitness.t ->
|
2020-02-12 20:40:17 +04:00
|
|
|
Context.t ->
|
|
|
|
(previous_protocol * context) tzresult Lwt.t
|
2019-09-05 17:21:01 +04:00
|
|
|
|
2020-02-12 20:40:17 +04:00
|
|
|
val activate : context -> Protocol_hash.t -> t Lwt.t
|
|
|
|
|
|
|
|
val fork_test_chain : context -> Protocol_hash.t -> Time.t -> t Lwt.t
|
2019-09-05 17:21:01 +04:00
|
|
|
|
|
|
|
(** Returns the state of the database resulting of operations on its
|
|
|
|
abstract view *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val recover : context -> Context.t
|
|
|
|
|
|
|
|
val current_level : context -> Level_repr.t
|
|
|
|
|
|
|
|
val predecessor_timestamp : context -> Time.t
|
|
|
|
|
|
|
|
val current_timestamp : context -> Time.t
|
2019-09-05 17:21:01 +04:00
|
|
|
|
2020-02-12 20:40:17 +04:00
|
|
|
val current_fitness : context -> Int64.t
|
2019-09-05 17:21:01 +04:00
|
|
|
|
2020-02-12 20:40:17 +04:00
|
|
|
val set_current_fitness : context -> Int64.t -> t
|
2019-09-05 17:21:01 +04:00
|
|
|
|
2020-02-12 20:40:17 +04:00
|
|
|
val constants : context -> Constants_repr.parametric
|
|
|
|
|
|
|
|
val patch_constants :
|
2019-09-05 17:21:01 +04:00
|
|
|
context ->
|
|
|
|
(Constants_repr.parametric -> Constants_repr.parametric) ->
|
|
|
|
context Lwt.t
|
2020-02-12 20:40:17 +04:00
|
|
|
|
|
|
|
val first_level : context -> Raw_level_repr.t
|
2019-09-05 17:21:01 +04:00
|
|
|
|
|
|
|
(** Increment the current block fee stash that will be credited to baker's
|
|
|
|
frozen_fees account at finalize_application *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val add_fees : context -> Tez_repr.t -> context tzresult Lwt.t
|
2019-09-05 17:21:01 +04:00
|
|
|
|
|
|
|
(** Increment the current block reward stash that will be credited to baker's
|
|
|
|
frozen_fees account at finalize_application *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val add_rewards : context -> Tez_repr.t -> context tzresult Lwt.t
|
2019-09-05 17:21:01 +04:00
|
|
|
|
|
|
|
(** Increment the current block deposit stash for a specific delegate. All the
|
|
|
|
delegates' frozen_deposit accounts are credited at finalize_application *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val add_deposit :
|
|
|
|
context ->
|
|
|
|
Signature.Public_key_hash.t ->
|
|
|
|
Tez_repr.t ->
|
|
|
|
context tzresult Lwt.t
|
|
|
|
|
|
|
|
val get_fees : context -> Tez_repr.t
|
2019-09-05 17:21:01 +04:00
|
|
|
|
2020-02-12 20:40:17 +04:00
|
|
|
val get_rewards : context -> Tez_repr.t
|
|
|
|
|
|
|
|
val get_deposits : context -> Tez_repr.t Signature.Public_key_hash.Map.t
|
2019-09-05 17:21:01 +04:00
|
|
|
|
|
|
|
type error += Gas_limit_too_high (* `Permanent *)
|
|
|
|
|
2020-02-12 20:40:17 +04:00
|
|
|
val check_gas_limit : t -> Z.t -> unit tzresult
|
|
|
|
|
|
|
|
val set_gas_limit : t -> Z.t -> t
|
|
|
|
|
|
|
|
val set_gas_unlimited : t -> t
|
|
|
|
|
|
|
|
val gas_level : t -> Gas_limit_repr.t
|
|
|
|
|
|
|
|
val gas_consumed : since:t -> until:t -> Z.t
|
|
|
|
|
|
|
|
val block_gas_level : t -> Z.t
|
|
|
|
|
|
|
|
val init_storage_space_to_pay : t -> t
|
|
|
|
|
|
|
|
val update_storage_space_to_pay : t -> Z.t -> t
|
2019-09-05 17:21:01 +04:00
|
|
|
|
2020-02-12 20:40:17 +04:00
|
|
|
val update_allocated_contracts_count : t -> t
|
|
|
|
|
|
|
|
val clear_storage_space_to_pay : t -> t * Z.t * int
|
2019-09-05 17:21:01 +04:00
|
|
|
|
|
|
|
type error += Undefined_operation_nonce (* `Permanent *)
|
|
|
|
|
2020-02-12 20:40:17 +04:00
|
|
|
val init_origination_nonce : t -> Operation_hash.t -> t
|
|
|
|
|
|
|
|
val origination_nonce : t -> Contract_repr.origination_nonce tzresult
|
|
|
|
|
|
|
|
val increment_origination_nonce :
|
|
|
|
t -> (t * Contract_repr.origination_nonce) tzresult
|
|
|
|
|
|
|
|
val unset_origination_nonce : t -> t
|
2019-09-05 17:21:01 +04:00
|
|
|
|
2019-10-17 13:45:27 +04:00
|
|
|
(** {1 Generic accessors} *)
|
2019-09-05 17:21:01 +04:00
|
|
|
|
|
|
|
type key = string list
|
|
|
|
|
|
|
|
type value = MBytes.t
|
|
|
|
|
|
|
|
(** All context manipulation functions. This signature is included
|
|
|
|
as-is for direct context accesses, and used in {!Storage_functors}
|
|
|
|
to provide restricted views to the context. *)
|
|
|
|
module type T = sig
|
|
|
|
type t
|
2020-02-12 20:40:17 +04:00
|
|
|
|
2019-09-05 17:21:01 +04:00
|
|
|
type context = t
|
|
|
|
|
|
|
|
(** Tells if the key is already defined as a value. *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val mem : context -> key -> bool Lwt.t
|
2019-09-05 17:21:01 +04:00
|
|
|
|
|
|
|
(** Tells if the key is already defined as a directory. *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val dir_mem : context -> key -> bool Lwt.t
|
2019-09-05 17:21:01 +04:00
|
|
|
|
|
|
|
(** Retrieve the value from the storage bucket ; returns a
|
|
|
|
{!Storage_error Missing_key} if the key is not set. *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val get : context -> key -> value tzresult Lwt.t
|
2019-09-05 17:21:01 +04:00
|
|
|
|
|
|
|
(** Retrieves the value from the storage bucket ; returns [None] if
|
|
|
|
the data is not initialized. *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val get_option : context -> key -> value option Lwt.t
|
2019-09-05 17:21:01 +04:00
|
|
|
|
|
|
|
(** Allocates the storage bucket and initializes it ; returns a
|
|
|
|
{!Storage_error Existing_key} if the bucket exists. *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val init : context -> key -> value -> context tzresult Lwt.t
|
2019-09-05 17:21:01 +04:00
|
|
|
|
|
|
|
(** Updates the content of the bucket ; returns a {!Storage_error
|
|
|
|
Missing_key} if the value does not exists. *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val set : context -> key -> value -> context tzresult Lwt.t
|
2019-09-05 17:21:01 +04:00
|
|
|
|
|
|
|
(** Allocates the data and initializes it with a value ; just
|
|
|
|
updates it if the bucket exists. *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val init_set : context -> key -> value -> context Lwt.t
|
2019-09-05 17:21:01 +04:00
|
|
|
|
|
|
|
(** When the value is [Some v], allocates the data and initializes
|
|
|
|
it with [v] ; just updates it if the bucket exists. When the
|
|
|
|
valus is [None], delete the storage bucket when the value ; does
|
|
|
|
nothing if the bucket does not exists. *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val set_option : context -> key -> value option -> context Lwt.t
|
2019-09-05 17:21:01 +04:00
|
|
|
|
|
|
|
(** Delete the storage bucket ; returns a {!Storage_error
|
|
|
|
Missing_key} if the bucket does not exists. *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val delete : context -> key -> context tzresult Lwt.t
|
2019-09-05 17:21:01 +04:00
|
|
|
|
|
|
|
(** Removes the storage bucket and its contents ; does nothing if the
|
|
|
|
bucket does not exists. *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val remove : context -> key -> context Lwt.t
|
2019-09-05 17:21:01 +04:00
|
|
|
|
|
|
|
(** Recursively removes all the storage buckets and contents ; does
|
|
|
|
nothing if no bucket exists. *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val remove_rec : context -> key -> context Lwt.t
|
2019-09-05 17:21:01 +04:00
|
|
|
|
2020-02-12 20:40:17 +04:00
|
|
|
val copy : context -> from:key -> to_:key -> context tzresult Lwt.t
|
2019-09-05 17:21:01 +04:00
|
|
|
|
|
|
|
(** Iterator on all the items of a given directory. *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val fold :
|
|
|
|
context ->
|
|
|
|
key ->
|
|
|
|
init:'a ->
|
|
|
|
f:([`Key of key | `Dir of key] -> 'a -> 'a Lwt.t) ->
|
2019-09-05 17:21:01 +04:00
|
|
|
'a Lwt.t
|
|
|
|
|
|
|
|
(** Recursively list all subkeys of a given key. *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val keys : context -> key -> key list Lwt.t
|
2019-09-05 17:21:01 +04:00
|
|
|
|
|
|
|
(** Recursive iterator on all the subkeys of a given key. *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val fold_keys :
|
2019-09-05 17:21:01 +04:00
|
|
|
context -> key -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t
|
|
|
|
|
|
|
|
(** Internally used in {!Storage_functors} to escape from a view. *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val project : context -> root_context
|
2019-09-05 17:21:01 +04:00
|
|
|
|
|
|
|
(** Internally used in {!Storage_functors} to retrieve a full key
|
|
|
|
from partial key relative a view. *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val absolute_key : context -> key -> key
|
2019-09-05 17:21:01 +04:00
|
|
|
|
|
|
|
(** Internally used in {!Storage_functors} to consume gas from
|
|
|
|
within a view. *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val consume_gas : context -> Gas_limit_repr.cost -> context tzresult
|
2019-09-05 17:21:01 +04:00
|
|
|
|
|
|
|
(** Check if consume_gas will fail *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val check_enough_gas : context -> Gas_limit_repr.cost -> unit tzresult
|
2019-09-05 17:21:01 +04:00
|
|
|
|
2020-02-12 20:40:17 +04:00
|
|
|
val description : context Storage_description.t
|
2019-09-05 17:21:01 +04:00
|
|
|
end
|
|
|
|
|
|
|
|
include T with type t := t and type context := context
|
|
|
|
|
|
|
|
(** Initialize the local nonce used for preventing a script to
|
|
|
|
duplicate an internal operation to replay it. *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val reset_internal_nonce : context -> context
|
2019-09-05 17:21:01 +04:00
|
|
|
|
|
|
|
(** Increments the internal operation nonce. *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val fresh_internal_nonce : context -> (context * int) tzresult
|
2019-09-05 17:21:01 +04:00
|
|
|
|
|
|
|
(** Mark an internal operation nonce as taken. *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val record_internal_nonce : context -> int -> context
|
2019-09-05 17:21:01 +04:00
|
|
|
|
|
|
|
(** Check is the internal operation nonce has been taken. *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val internal_nonce_already_recorded : context -> int -> bool
|
2019-09-05 17:21:01 +04:00
|
|
|
|
|
|
|
(** Returns a map where to each endorser's pkh is associated the list of its
|
|
|
|
endorsing slots (in decreasing order) for a given level. *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val allowed_endorsements :
|
2019-09-05 17:21:01 +04:00
|
|
|
context ->
|
|
|
|
(Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t
|
|
|
|
|
2019-10-17 13:45:27 +04:00
|
|
|
(** Keep track of the number of endorsements that are included in a block *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val included_endorsements : context -> int
|
2019-10-17 13:45:27 +04:00
|
|
|
|
2019-09-05 17:21:01 +04:00
|
|
|
(** Initializes the map of allowed endorsements, this function must only be
|
|
|
|
called once. *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val init_endorsements :
|
2019-09-05 17:21:01 +04:00
|
|
|
context ->
|
|
|
|
(Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t ->
|
|
|
|
context
|
|
|
|
|
|
|
|
(** Marks an endorsment in the map as used. *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val record_endorsement : context -> Signature.Public_key_hash.t -> context
|
2019-10-17 13:45:27 +04:00
|
|
|
|
|
|
|
(** Provide a fresh identifier for a temporary big map (negative index). *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val fresh_temporary_big_map : context -> context * Z.t
|
2019-10-17 13:45:27 +04:00
|
|
|
|
|
|
|
(** Reset the temporary big_map identifier generator to [-1]. *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val reset_temporary_big_map : context -> context
|
2019-10-17 13:45:27 +04:00
|
|
|
|
|
|
|
(** Iterate over all created temporary big maps since the last {!reset_temporary_big_map}. *)
|
2020-02-12 20:40:17 +04:00
|
|
|
val temporary_big_maps : context -> ('a -> Z.t -> 'a Lwt.t) -> 'a -> 'a Lwt.t
|