diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 57158c266..d540d1e57 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -326,10 +326,10 @@ opam:22:tezos-protocol-alpha: variables: package: tezos-protocol-alpha -opam:23:tezos-protocol-environment-client: +opam:23:tezos-protocol-environment: <<: *opam_definition variables: - package: tezos-protocol-environment-client + package: tezos-protocol-environment opam:24:tezos-client-alpha: <<: *opam_definition @@ -436,6 +436,11 @@ opam:44:tezos-protocol-demo: variables: package: tezos-protocol-demo +opam:45:tezos-protocol-environment-shell: + <<: *opam_definition + variables: + package: tezos-protocol-environment-shell + ##END_OPAM## diff --git a/src/lib_base/jbuild b/src/lib_base/jbuild index c59b4c5a9..c1d5b787b 100644 --- a/src/lib_base/jbuild +++ b/src/lib_base/jbuild @@ -17,7 +17,6 @@ tezos-error-monad tezos-rpc tezos-micheline - tezos-protocol-environment-sigs re.str calendar ezjsonm diff --git a/src/lib_base/protocol_environment.ml b/src/lib_base/protocol_environment.ml deleted file mode 100644 index 2df556e04..000000000 --- a/src/lib_base/protocol_environment.ml +++ /dev/null @@ -1,548 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2018. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -open Error_monad - -module type CONTEXT = sig - type t - type key = string list - type value = MBytes.t - val mem: t -> key -> bool Lwt.t - val dir_mem: t -> key -> bool Lwt.t - val get: t -> key -> value option Lwt.t - val set: t -> key -> value -> t Lwt.t - val del: t -> key -> t Lwt.t - val remove_rec: t -> key -> t Lwt.t - val fold: - t -> key -> init:'a -> - f:([ `Key of key | `Dir of key ] -> 'a -> 'a Lwt.t) -> - 'a Lwt.t -end - -module type UPDATER = sig - - module Context : CONTEXT - - type validation_result = { - context: Context.t ; - fitness: Fitness.t ; - message: string option ; - max_operation_data_length: int ; - max_operations_ttl: int ; - } - - type quota = { - max_size: int ; - max_op: int option ; - } - - type rpc_context = { - block_hash: Block_hash.t ; - block_header: Block_header.t ; - operation_hashes: unit -> Operation_hash.t list list Lwt.t ; - operations: unit -> Operation.t list list Lwt.t ; - context: Context.t ; - } - - val compile: Protocol_hash.t -> Protocol.t -> bool Lwt.t - val activate: Context.t -> Protocol_hash.t -> Context.t Lwt.t - val fork_test_chain: - Context.t -> protocol:Protocol_hash.t -> expiration:Time.t -> Context.t Lwt.t - -end - -module type T = sig - type context - type quota - type validation_result - type rpc_context - type 'a tzresult - val max_block_length: int - val validation_passes: quota list - type operation - val parse_operation: - Operation_hash.t -> Operation.t -> operation tzresult - val acceptable_passes: operation -> int list - val compare_operations: operation -> operation -> int - type validation_state - val current_context: validation_state -> context tzresult Lwt.t - val precheck_block: - ancestor_context: context -> - ancestor_timestamp: Time.t -> - Block_header.t -> - unit tzresult Lwt.t - val begin_application: - predecessor_context: context -> - predecessor_timestamp: Time.t -> - predecessor_fitness: Fitness.t -> - Block_header.t -> - validation_state tzresult Lwt.t - val begin_construction: - predecessor_context: context -> - predecessor_timestamp: Time.t -> - predecessor_level: Int32.t -> - predecessor_fitness: Fitness.t -> - predecessor: Block_hash.t -> - timestamp: Time.t -> - ?protocol_data: MBytes.t -> - unit -> validation_state tzresult Lwt.t - val apply_operation: - validation_state -> operation -> validation_state tzresult Lwt.t - val finalize_block: - validation_state -> validation_result tzresult Lwt.t - val rpc_services: rpc_context Lwt.t RPC_directory.t - val configure_sandbox: - context -> Data_encoding.json option -> context tzresult Lwt.t -end - -module type V1 = sig - - include Tezos_protocol_environment_sigs.V1.T - with type Format.formatter = Format.formatter - and type 'a Data_encoding.t = 'a Data_encoding.t - and type 'a Lwt.t = 'a Lwt.t - and type ('a, 'b) Pervasives.result = ('a, 'b) result - and type Block_hash.t = Block_hash.t - and type Operation_hash.t = Operation_hash.t - and type Operation_list_hash.t = Operation_list_hash.t - and type Operation_list_list_hash.t = Operation_list_list_hash.t - and type Context_hash.t = Context_hash.t - and type Protocol_hash.t = Protocol_hash.t - and type Time.t = Time.t - and type MBytes.t = MBytes.t - and type Operation.shell_header = Operation.shell_header - and type Operation.t = Operation.t - and type Block_header.shell_header = Block_header.shell_header - and type Block_header.t = Block_header.t - and type 'a RPC_directory.t = 'a RPC_directory.t - and type Ed25519.Public_key_hash.t = Ed25519.Public_key_hash.t - and type Ed25519.Public_key.t = Ed25519.Public_key.t - and type Ed25519.Secret_key.t = Ed25519.Secret_key.t - and type Ed25519.Signature.t = Ed25519.Signature.t - and type 'a Micheline.canonical = 'a Micheline.canonical - and type ('a, 'b) RPC_path.t = ('a, 'b) RPC_path.t - and type ('a, 'b) Micheline.node = ('a, 'b) Micheline.node - and type Data_encoding.json_schema = Data_encoding.json_schema - and type RPC_service.meth = RPC_service.meth - and type (+'m,'pr,'p,'q,'i,'o) RPC_service.t = ('m,'pr,'p,'q,'i,'o) RPC_service.t - and type Error_monad.shell_error = Error_monad.error - - type error += Ecoproto_error of Error_monad.error list - val wrap_error : 'a Error_monad.tzresult -> 'a tzresult - - module Lift (P : Updater.PROTOCOL) : - T with type context := Context.t - and type quota := Updater.quota - and type validation_result := Updater.validation_result - and type rpc_context := Updater.rpc_context - and type 'a tzresult := 'a tzresult - - class ['block] proto_rpc_context : - Tezos_rpc.RPC_context.t -> (unit, unit * 'block) RPC_path.t -> - ['block] RPC_context.simple - - class ['block] proto_rpc_context_of_directory : - ('block -> RPC_context.t) -> RPC_context.t RPC_directory.t -> - ['block] RPC_context.simple - -end - -module MakeV1 - (Param : sig val name: string end) - (Context : CONTEXT) - (Updater : UPDATER with module Context := Context) - () = struct - - include Pervasives - module Pervasives = Pervasives - module Compare = Compare - module Array = Array - module List = List - module Bytes = struct - include Bytes - include EndianBytes.BigEndian - module LE = EndianBytes.LittleEndian - end - module String = struct - include String - include EndianString.BigEndian - module LE = EndianString.LittleEndian - end - module Set = Set - module Map = Map - module Int32 = Int32 - module Int64 = Int64 - module Nativeint = Nativeint - module Buffer = Buffer - module Format = Format - module Option = Option - module Z = Z - module Lwt_sequence = Lwt_sequence - module Lwt = Lwt - module Lwt_list = Lwt_list - module MBytes = MBytes - module Uri = Uri - module Data_encoding = Data_encoding - module Time = Time - module Ed25519 = Ed25519 - module S = S - module Error_monad = struct - type 'a shell_tzresult = 'a Error_monad.tzresult - type shell_error = Error_monad.error = .. - type error_category = [ `Branch | `Temporary | `Permanent ] - include Error_monad.Make() - end - - type error += Ecoproto_error of Error_monad.error list - - let () = - let id = Format.asprintf "Ecoproto.%s" Param.name in - register_wrapped_error_kind - (fun ecoerrors -> Error_monad.classify_errors ecoerrors) - ~id ~title:"Error returned by the protocol" - ~description:"Wrapped error for the economic protocol." - ~pp:(fun ppf -> - Format.fprintf ppf - "@[Economic error:@ %a@]" - (Format.pp_print_list Error_monad.pp)) - Data_encoding.(obj1 (req "ecoproto" - (list Error_monad.error_encoding))) - (function Ecoproto_error ecoerrors -> Some ecoerrors - | _ -> None ) - (function ecoerrors -> Ecoproto_error ecoerrors) - - let wrap_error = function - | Ok _ as ok -> ok - | Error errors -> Error [Ecoproto_error errors] - - module Block_hash = Block_hash - module Operation_hash = Operation_hash - module Operation_list_hash = Operation_list_hash - module Operation_list_list_hash = Operation_list_list_hash - module Context_hash = Context_hash - module Protocol_hash = Protocol_hash - module Blake2B = Blake2B - module Fitness = Fitness - module Operation = Operation - module Block_header = Block_header - module Protocol = Protocol - module RPC_arg = RPC_arg - module RPC_path = RPC_path - module RPC_query = RPC_query - module RPC_service = RPC_service - module RPC_answer = struct - - type 'o t = - [ `Ok of 'o (* 200 *) - | `OkStream of 'o stream (* 200 *) - | `Created of string option (* 201 *) - | `No_content (* 204 *) - | `Unauthorized of Error_monad.error list option (* 401 *) - | `Forbidden of Error_monad.error list option (* 403 *) - | `Not_found of Error_monad.error list option (* 404 *) - | `Conflict of Error_monad.error list option (* 409 *) - | `Error of Error_monad.error list option (* 500 *) - ] - - and 'a stream = 'a Resto_directory.Answer.stream = { - next: unit -> 'a option Lwt.t ; - shutdown: unit -> unit ; - } - - let return x = Lwt.return (`Ok x) - let return_stream x = Lwt.return (`OkStream x) - let not_found = Lwt.return (`Not_found None) - - let fail err = Lwt.return (`Error (Some err)) - end - module RPC_directory = struct - include RPC_directory - let gen_register dir service handler = - gen_register dir service - (fun p q i -> - handler p q i >>= function - | `Ok o -> RPC_answer.return o - | `OkStream s -> RPC_answer.return_stream s - | `Created s -> Lwt.return (`Created s) - | `No_content -> Lwt.return (`No_content) - | `Unauthorized e -> - let e = Option.map e ~f:(fun e -> [Ecoproto_error e]) in - Lwt.return (`Unauthorized e) - | `Forbidden e -> - let e = Option.map e ~f:(fun e -> [Ecoproto_error e]) in - Lwt.return (`Forbidden e) - | `Not_found e -> - let e = Option.map e ~f:(fun e -> [Ecoproto_error e]) in - Lwt.return (`Not_found e) - | `Conflict e -> - let e = Option.map e ~f:(fun e -> [Ecoproto_error e]) in - Lwt.return (`Conflict e) - | `Error e -> - let e = Option.map e ~f:(fun e -> [Ecoproto_error e]) in - Lwt.return (`Error e)) - - let register dir service handler = - gen_register dir service - (fun p q i -> - handler p q i >>= function - | Ok o -> RPC_answer.return o - | Error e -> RPC_answer.fail e) - - let lwt_register dir service handler = - gen_register dir service - (fun p q i -> - handler p q i >>= fun o -> - RPC_answer.return o) - - open Curry - - let register0 root s f = register root s (curry Z f) - let register1 root s f = register root s (curry (S Z) f) - let register2 root s f = register root s (curry (S (S Z)) f) - let register3 root s f = register root s (curry (S (S (S Z))) f) - let register4 root s f = register root s (curry (S (S (S (S Z)))) f) - let register5 root s f = register root s (curry (S (S (S (S (S Z))))) f) - - let gen_register0 root s f = gen_register root s (curry Z f) - let gen_register1 root s f = gen_register root s (curry (S Z) f) - let gen_register2 root s f = gen_register root s (curry (S (S Z)) f) - let gen_register3 root s f = gen_register root s (curry (S (S (S Z))) f) - let gen_register4 root s f = gen_register root s (curry (S (S (S (S Z)))) f) - let gen_register5 root s f = gen_register root s (curry (S (S (S (S (S Z))))) f) - - let lwt_register0 root s f = lwt_register root s (curry Z f) - let lwt_register1 root s f = lwt_register root s (curry (S Z) f) - let lwt_register2 root s f = lwt_register root s (curry (S (S Z)) f) - let lwt_register3 root s f = lwt_register root s (curry (S (S (S Z))) f) - let lwt_register4 root s f = lwt_register root s (curry (S (S (S (S Z)))) f) - let lwt_register5 root s f = lwt_register root s (curry (S (S (S (S (S Z))))) f) - - end - module RPC_context = struct - - type t = Updater.rpc_context Lwt.t - - class type ['pr] simple = object - method call_proto_service0 : - 'm 'q 'i 'o. - ([< RPC_service.meth ] as 'm, t, t, 'q, 'i, 'o) RPC_service.t -> - 'pr -> 'q -> 'i -> 'o Error_monad.shell_tzresult Lwt.t - method call_proto_service1 : - 'm 'a 'q 'i 'o. - ([< RPC_service.meth ] as 'm, t, t * 'a, 'q, 'i, 'o) RPC_service.t -> - 'pr -> 'a -> 'q -> 'i -> 'o Error_monad.shell_tzresult Lwt.t - method call_proto_service2 : - 'm 'a 'b 'q 'i 'o. - ([< RPC_service.meth ] as 'm, t, (t * 'a) * 'b, 'q, 'i, 'o) RPC_service.t -> - 'pr -> 'a -> 'b -> 'q -> 'i -> 'o Error_monad.shell_tzresult Lwt.t - method call_proto_service3 : - 'm 'a 'b 'c 'q 'i 'o. - ([< RPC_service.meth ] as 'm, t, ((t * 'a) * 'b) * 'c, 'q, 'i, 'o) RPC_service.t -> - 'pr -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o Error_monad.shell_tzresult Lwt.t - end - - let make_call0 s (ctxt : _ simple) = - ctxt#call_proto_service0 s - let make_call0 = (make_call0 : _ -> _ simple -> _ :> _ -> _ #simple -> _) - - let make_call1 s (ctxt: _ simple) = - ctxt#call_proto_service1 s - let make_call1 = (make_call1 : _ -> _ simple -> _ :> _ -> _ #simple -> _) - - let make_call2 s (ctxt: _ simple) = - ctxt#call_proto_service2 s - let make_call2 = (make_call2 : _ -> _ simple -> _ :> _ -> _ #simple -> _) - - let make_call3 s (ctxt: _ simple) = - ctxt#call_proto_service3 s - let make_call3 = (make_call3 : _ -> _ simple -> _ :> _ -> _ #simple -> _) - - let make_opt_call0 s ctxt block q i = - make_call0 s ctxt block q i >>= function - | Error [RPC_context.Not_found _] -> Lwt.return (Ok None) - | Error _ as v -> Lwt.return v - | Ok v -> Lwt.return (Ok (Some v)) - - let make_opt_call1 s ctxt block a1 q i = - make_call1 s ctxt block a1 q i >>= function - | Error [RPC_context.Not_found _] -> Lwt.return (Ok None) - | Error _ as v -> Lwt.return v - | Ok v -> Lwt.return (Ok (Some v)) - - let make_opt_call2 s ctxt block a1 a2 q i = - make_call2 s ctxt block a1 a2 q i >>= function - | Error [RPC_context.Not_found _] -> Lwt.return (Ok None) - | Error _ as v -> Lwt.return v - | Ok v -> Lwt.return (Ok (Some v)) - - let make_opt_call3 s ctxt block a1 a2 a3 q i = - make_call3 s ctxt block a1 a2 a3 q i >>= function - | Error [RPC_context.Not_found _] -> Lwt.return (Ok None) - | Error _ as v -> Lwt.return v - | Ok v -> Lwt.return (Ok (Some v)) - - end - module Micheline = Micheline - module Logging = Logging.Make(Param) - - module Updater = struct - - include Updater - - module type PROTOCOL = - T with type context := Context.t - and type quota := Updater.quota - and type validation_result := Updater.validation_result - and type rpc_context := Updater.rpc_context - and type 'a tzresult := 'a Error_monad.tzresult - - end - module Base58 = struct - include Tezos_crypto.Base58 - let simple_encode enc s = simple_encode enc s - let simple_decode enc s = simple_decode enc s - include Make(struct type context = Context.t end) - let decode s = decode s - end - module Context = struct - include Context - - let fold_keys s k ~init ~f = - let rec loop k acc = - fold s k ~init:acc - ~f:(fun file acc -> - match file with - | `Key k -> f k acc - | `Dir k -> loop k acc) in - loop k init - - let keys t = fold_keys t ~init:[] ~f:(fun k acc -> Lwt.return (k :: acc)) - - let register_resolver = Base58.register_resolver - let complete ctxt s = Base58.complete ctxt s - end - - module Lift(P : Updater.PROTOCOL) = struct - include P - let precheck_block - ~ancestor_context ~ancestor_timestamp - raw_block = - precheck_block - ~ancestor_context ~ancestor_timestamp - raw_block >|= wrap_error - let begin_application - ~predecessor_context ~predecessor_timestamp - ~predecessor_fitness - raw_block = - begin_application - ~predecessor_context ~predecessor_timestamp - ~predecessor_fitness - raw_block >|= wrap_error - let begin_construction - ~predecessor_context ~predecessor_timestamp - ~predecessor_level ~predecessor_fitness - ~predecessor ~timestamp ?protocol_data () = - begin_construction - ~predecessor_context ~predecessor_timestamp - ~predecessor_level ~predecessor_fitness - ~predecessor ~timestamp ?protocol_data () >|= wrap_error - let current_context c = - current_context c >|= wrap_error - let apply_operation c o = - apply_operation c o >|= wrap_error - let finalize_block c = finalize_block c >|= wrap_error - let parse_operation h b = parse_operation h b |> wrap_error - let configure_sandbox c j = - configure_sandbox c j >|= wrap_error - end - - class ['block] proto_rpc_context - (t : Tezos_rpc.RPC_context.t) - (prefix : (unit, unit * 'block) RPC_path.t) = - object - method call_proto_service0 - : 'm 'q 'i 'o. - ([< RPC_service.meth ] as 'm, RPC_context.t, - RPC_context.t, 'q, 'i, 'o) RPC_service.t -> - 'block -> 'q -> 'i -> 'o tzresult Lwt.t - = fun s block q i -> - let s = RPC_service.subst0 s in - let s = RPC_service.prefix prefix s in - t#call_service s ((), block) q i - method call_proto_service1 - : 'm 'a 'q 'i 'o. - ([< RPC_service.meth ] as 'm, RPC_context.t, - RPC_context.t * 'a, 'q, 'i, 'o) RPC_service.t -> - 'block -> 'a -> 'q -> 'i -> 'o tzresult Lwt.t - = fun s block a1 q i -> - let s = RPC_service.subst1 s in - let s = RPC_service.prefix prefix s in - t#call_service s (((), block), a1) q i - method call_proto_service2 - : 'm 'a 'b 'q 'i 'o. - ([< RPC_service.meth ] as 'm, RPC_context.t, - (RPC_context.t * 'a) * 'b, 'q, 'i, 'o) RPC_service.t -> - 'block -> 'a -> 'b -> 'q -> 'i -> 'o tzresult Lwt.t - = fun s block a1 a2 q i -> - let s = RPC_service.subst2 s in - let s = RPC_service.prefix prefix s in - t#call_service s ((((), block), a1), a2) q i - method call_proto_service3 - : 'm 'a 'b 'c 'q 'i 'o. - ([< RPC_service.meth ] as 'm, RPC_context.t, - ((RPC_context.t * 'a) * 'b) * 'c, - 'q, 'i, 'o) RPC_service.t -> - 'block -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o tzresult Lwt.t - = fun s block a1 a2 a3 q i -> - let s = RPC_service.subst3 s in - let s = RPC_service.prefix prefix s in - t#call_service s (((((), block), a1), a2), a3) q i - end - - class ['block] proto_rpc_context_of_directory conv dir : ['block] RPC_context.simple = - let lookup = new Tezos_rpc.RPC_context.of_directory dir in - object - method call_proto_service0 - : 'm 'q 'i 'o. - ([< RPC_service.meth ] as 'm, RPC_context.t, - RPC_context.t, 'q, 'i, 'o) RPC_service.t -> - 'block -> 'q -> 'i -> 'o tzresult Lwt.t - = fun s block q i -> - let rpc_context = conv block in - lookup#call_service s rpc_context q i - method call_proto_service1 - : 'm 'a 'q 'i 'o. - ([< RPC_service.meth ] as 'm, RPC_context.t, - RPC_context.t * 'a, 'q, 'i, 'o) RPC_service.t -> - 'block -> 'a -> 'q -> 'i -> 'o tzresult Lwt.t - = fun s block a1 q i -> - let rpc_context = conv block in - lookup#call_service s (rpc_context, a1) q i - method call_proto_service2 - : 'm 'a 'b 'q 'i 'o. - ([< RPC_service.meth ] as 'm, RPC_context.t, - (RPC_context.t * 'a) * 'b, 'q, 'i, 'o) RPC_service.t -> - 'block -> 'a -> 'b -> 'q -> 'i -> 'o tzresult Lwt.t - = fun s block a1 a2 q i -> - let rpc_context = conv block in - lookup#call_service s ((rpc_context, a1), a2) q i - method call_proto_service3 - : 'm 'a 'b 'c 'q 'i 'o. - ([< RPC_service.meth ] as 'm, RPC_context.t, - ((RPC_context.t * 'a) * 'b) * 'c, - 'q, 'i, 'o) RPC_service.t -> - 'block -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o tzresult Lwt.t - = fun s block a1 a2 a3 q i -> - let rpc_context = conv block in - lookup#call_service s (((rpc_context, a1), a2), a3) q i - end - -end - - diff --git a/src/lib_base/protocol_environment.mli b/src/lib_base/protocol_environment.mli deleted file mode 100644 index 2e3a1557c..000000000 --- a/src/lib_base/protocol_environment.mli +++ /dev/null @@ -1,157 +0,0 @@ - -open Error_monad - - -module type CONTEXT = sig - type t - type key = string list - type value = MBytes.t - val mem: t -> key -> bool Lwt.t - val dir_mem: t -> key -> bool Lwt.t - val get: t -> key -> value option Lwt.t - val set: t -> key -> value -> t Lwt.t - val del: t -> key -> t Lwt.t - val remove_rec: t -> key -> t Lwt.t - val fold: - t -> key -> init:'a -> - f:([ `Key of key | `Dir of key ] -> 'a -> 'a Lwt.t) -> - 'a Lwt.t -end - -module type UPDATER = sig - - module Context : CONTEXT - - type validation_result = { - context: Context.t ; - fitness: Fitness.t ; - message: string option ; - max_operation_data_length: int ; - max_operations_ttl: int ; - } - - type quota = { - max_size: int ; - max_op: int option ; - } - - type rpc_context = { - block_hash: Block_hash.t ; - block_header: Block_header.t ; - operation_hashes: unit -> Operation_hash.t list list Lwt.t ; - operations: unit -> Operation.t list list Lwt.t ; - context: Context.t ; - } - - val compile: Protocol_hash.t -> Protocol.t -> bool Lwt.t - val activate: Context.t -> Protocol_hash.t -> Context.t Lwt.t - val fork_test_chain: - Context.t -> protocol:Protocol_hash.t -> expiration:Time.t -> Context.t Lwt.t - -end - -module type T = sig - type context - type quota - type validation_result - type rpc_context - type 'a tzresult - val max_block_length: int - val validation_passes: quota list - type operation - val parse_operation: - Operation_hash.t -> Operation.t -> operation tzresult - val acceptable_passes: operation -> int list - val compare_operations: operation -> operation -> int - type validation_state - val current_context: validation_state -> context tzresult Lwt.t - val precheck_block: - ancestor_context: context -> - ancestor_timestamp: Time.t -> - Block_header.t -> - unit tzresult Lwt.t - val begin_application: - predecessor_context: context -> - predecessor_timestamp: Time.t -> - predecessor_fitness: Fitness.t -> - Block_header.t -> - validation_state tzresult Lwt.t - val begin_construction: - predecessor_context: context -> - predecessor_timestamp: Time.t -> - predecessor_level: Int32.t -> - predecessor_fitness: Fitness.t -> - predecessor: Block_hash.t -> - timestamp: Time.t -> - ?protocol_data: MBytes.t -> - unit -> validation_state tzresult Lwt.t - val apply_operation: - validation_state -> operation -> validation_state tzresult Lwt.t - val finalize_block: - validation_state -> validation_result tzresult Lwt.t - val rpc_services: rpc_context Lwt.t RPC_directory.t - val configure_sandbox: - context -> Data_encoding.json option -> context tzresult Lwt.t -end - -module type V1 = sig - - include Tezos_protocol_environment_sigs.V1.T - with type Format.formatter = Format.formatter - and type 'a Data_encoding.t = 'a Data_encoding.t - and type 'a Lwt.t = 'a Lwt.t - and type ('a, 'b) Pervasives.result = ('a, 'b) result - and type Block_hash.t = Block_hash.t - and type Operation_hash.t = Operation_hash.t - and type Operation_list_hash.t = Operation_list_hash.t - and type Operation_list_list_hash.t = Operation_list_list_hash.t - and type Context_hash.t = Context_hash.t - and type Protocol_hash.t = Protocol_hash.t - and type Time.t = Time.t - and type MBytes.t = MBytes.t - and type Operation.shell_header = Operation.shell_header - and type Operation.t = Operation.t - and type Block_header.shell_header = Block_header.shell_header - and type Block_header.t = Block_header.t - and type 'a RPC_directory.t = 'a RPC_directory.t - and type Ed25519.Public_key_hash.t = Ed25519.Public_key_hash.t - and type Ed25519.Public_key.t = Ed25519.Public_key.t - and type Ed25519.Secret_key.t = Ed25519.Secret_key.t - and type Ed25519.Signature.t = Ed25519.Signature.t - and type 'a Micheline.canonical = 'a Micheline.canonical - and type ('a, 'b) Micheline.node = ('a, 'b) Micheline.node - and type Data_encoding.json_schema = Data_encoding.json_schema - and type ('a, 'b) RPC_path.t = ('a, 'b) RPC_path.t - and type RPC_service.meth = RPC_service.meth - and type (+'m,'pr,'p,'q,'i,'o) RPC_service.t = ('m,'pr,'p,'q,'i,'o) RPC_service.t - and type Error_monad.shell_error = Error_monad.error - - type error += Ecoproto_error of Error_monad.error list - val wrap_error : 'a Error_monad.tzresult -> 'a tzresult - - module Lift (P : Updater.PROTOCOL) : - T with type context := Context.t - and type quota := Updater.quota - and type validation_result := Updater.validation_result - and type rpc_context := Updater.rpc_context - and type 'a tzresult := 'a tzresult - - class ['block] proto_rpc_context : - Tezos_rpc.RPC_context.t -> (unit, unit * 'block) RPC_path.t -> - ['block] RPC_context.simple - - class ['block] proto_rpc_context_of_directory : - ('block -> RPC_context.t) -> RPC_context.t RPC_directory.t -> - ['block] RPC_context.simple - -end - -module MakeV1 - (Param : sig val name: string end) - (Context : CONTEXT) - (Updater : UPDATER with module Context := Context) - () : V1 with type Context.t = Context.t - and type Updater.validation_result = Updater.validation_result - and type Updater.quota = Updater.quota - and type Updater.rpc_context = Updater.rpc_context - diff --git a/src/lib_base/tezos-base.opam b/src/lib_base/tezos-base.opam index 19521a9be..bdccfdc07 100644 --- a/src/lib_base/tezos-base.opam +++ b/src/lib_base/tezos-base.opam @@ -15,7 +15,6 @@ depends: [ "tezos-error-monad" "tezos-micheline" "tezos-rpc" - "tezos-protocol-environment-sigs" "calendar" "ezjsonm" { >= "0.5.0" } "ipaddr" diff --git a/src/lib_base/tzPervasives.ml b/src/lib_base/tzPervasives.ml index 4cf06a14d..f66942338 100644 --- a/src/lib_base/tzPervasives.ml +++ b/src/lib_base/tzPervasives.ml @@ -55,8 +55,6 @@ module P2p_connection = P2p_connection module P2p_stat = P2p_stat module P2p_version = P2p_version -module Protocol_environment = Protocol_environment - module Cli_entries = Cli_entries module Lwt_exit = Lwt_exit diff --git a/src/lib_base/tzPervasives.mli b/src/lib_base/tzPervasives.mli index 3f60cef4e..ad84aa8d7 100644 --- a/src/lib_base/tzPervasives.mli +++ b/src/lib_base/tzPervasives.mli @@ -52,8 +52,6 @@ module P2p_connection = P2p_connection module P2p_stat = P2p_stat module P2p_version = P2p_version -module Protocol_environment = Protocol_environment - module Cli_entries = Cli_entries module Lwt_exit = Lwt_exit diff --git a/src/lib_protocol_compiler/jbuild_embedded_protocol_template b/src/lib_protocol_compiler/jbuild_embedded_protocol_template index 0fac72ddb..5c1b31d02 100644 --- a/src/lib_protocol_compiler/jbuild_embedded_protocol_template +++ b/src/lib_protocol_compiler/jbuild_embedded_protocol_template @@ -22,7 +22,7 @@ let () = Format.kasprintf Jbuild_plugin.V1.send {| ((targets (environment.ml)) (action (write-file ${@@} - "include Tezos_protocol_updater.Updater.MakeV1(struct let name = \"%s\" end)()")))) + "include Tezos_protocol_environment_shell.MakeV1(struct let name = \"%s\" end)()")))) (rule ((targets (registerer.ml)) @@ -35,7 +35,7 @@ let () = Format.kasprintf Jbuild_plugin.V1.send {| ((name tezos_embedded_protocol_environment_%s) (public_name tezos-embedded-protocol-%s.environment) (library_flags (:standard -linkall)) - (libraries (tezos-protocol-updater)) + (libraries (tezos-protocol-environment-shell)) (modules (Environment)))) (library @@ -55,7 +55,9 @@ let () = Format.kasprintf Jbuild_plugin.V1.send {| ((name tezos_embedded_protocol_%s) (public_name tezos-embedded-protocol-%s) (library_flags (:standard -linkall)) - (libraries (tezos_embedded_raw_protocol_%s tezos-protocol-updater)) + (libraries (tezos_embedded_raw_protocol_%s + tezos-protocol-updater + tezos-protocol-environment-shell)) (modules (Registerer)))) |} version version version version version version version version diff --git a/src/lib_protocol_environment/jbuild b/src/lib_protocol_environment/jbuild new file mode 100644 index 000000000..6ad276f59 --- /dev/null +++ b/src/lib_protocol_environment/jbuild @@ -0,0 +1,31 @@ +(jbuild_version 1) + +(library + ((name tezos_protocol_environment) + (public_name tezos-protocol-environment) + (libraries (tezos-base + tezos-protocol-environment-sigs + tezos-micheline)) + (flags (:standard -w -9+27-30-32-40@8 + -safe-string + -open Tezos_base__TzPervasives + -open Tezos_micheline)) + (wrapped false) + (modules (Tezos_protocol_environment + Tezos_protocol_environment_faked + Tezos_protocol_environment_memory)))) + +(library + ((name tezos_protocol_environment_shell) + (public_name tezos-protocol-environment-shell) + (libraries (tezos-base + tezos-protocol-environment + tezos-storage)) + (flags (:standard -w -9+27-30-32-40@8 + -safe-string)) + (modules (Tezos_protocol_environment_shell)))) + +(alias + ((name runtest_indent) + (deps ((glob_files *.ml*))) + (action (run bash ${libexec:tezos-stdlib:test-ocp-indent.sh} ${^})))) diff --git a/src/lib_protocol_environment_sigs/jbuild b/src/lib_protocol_environment/sigs/jbuild similarity index 94% rename from src/lib_protocol_environment_sigs/jbuild rename to src/lib_protocol_environment/sigs/jbuild index 76637c878..ffeff20bc 100644 --- a/src/lib_protocol_environment_sigs/jbuild +++ b/src/lib_protocol_environment/sigs/jbuild @@ -63,7 +63,7 @@ )) (action (with-stdout-to ${@} - (chdir ${ROOT} (run ${exe:sigs_packer/sigs_packer.exe} ${^})))))) + (chdir ${ROOT} (run ${exe:../sigs_packer/sigs_packer.exe} ${^})))))) (library ((name tezos_protocol_environment_sigs) diff --git a/src/lib_protocol_environment_sigs/v1/RPC_answer.mli b/src/lib_protocol_environment/sigs/v1/RPC_answer.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/RPC_answer.mli rename to src/lib_protocol_environment/sigs/v1/RPC_answer.mli diff --git a/src/lib_protocol_environment_sigs/v1/RPC_arg.mli b/src/lib_protocol_environment/sigs/v1/RPC_arg.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/RPC_arg.mli rename to src/lib_protocol_environment/sigs/v1/RPC_arg.mli diff --git a/src/lib_protocol_environment_sigs/v1/RPC_context.mli b/src/lib_protocol_environment/sigs/v1/RPC_context.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/RPC_context.mli rename to src/lib_protocol_environment/sigs/v1/RPC_context.mli diff --git a/src/lib_protocol_environment_sigs/v1/RPC_directory.mli b/src/lib_protocol_environment/sigs/v1/RPC_directory.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/RPC_directory.mli rename to src/lib_protocol_environment/sigs/v1/RPC_directory.mli diff --git a/src/lib_protocol_environment_sigs/v1/RPC_path.mli b/src/lib_protocol_environment/sigs/v1/RPC_path.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/RPC_path.mli rename to src/lib_protocol_environment/sigs/v1/RPC_path.mli diff --git a/src/lib_protocol_environment_sigs/v1/RPC_query.mli b/src/lib_protocol_environment/sigs/v1/RPC_query.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/RPC_query.mli rename to src/lib_protocol_environment/sigs/v1/RPC_query.mli diff --git a/src/lib_protocol_environment_sigs/v1/RPC_service.mli b/src/lib_protocol_environment/sigs/v1/RPC_service.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/RPC_service.mli rename to src/lib_protocol_environment/sigs/v1/RPC_service.mli diff --git a/src/lib_protocol_environment_sigs/v1/array.mli b/src/lib_protocol_environment/sigs/v1/array.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/array.mli rename to src/lib_protocol_environment/sigs/v1/array.mli diff --git a/src/lib_protocol_environment_sigs/v1/base58.mli b/src/lib_protocol_environment/sigs/v1/base58.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/base58.mli rename to src/lib_protocol_environment/sigs/v1/base58.mli diff --git a/src/lib_protocol_environment_sigs/v1/blake2B.mli b/src/lib_protocol_environment/sigs/v1/blake2B.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/blake2B.mli rename to src/lib_protocol_environment/sigs/v1/blake2B.mli diff --git a/src/lib_protocol_environment_sigs/v1/block_hash.mli b/src/lib_protocol_environment/sigs/v1/block_hash.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/block_hash.mli rename to src/lib_protocol_environment/sigs/v1/block_hash.mli diff --git a/src/lib_protocol_environment_sigs/v1/block_header.mli b/src/lib_protocol_environment/sigs/v1/block_header.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/block_header.mli rename to src/lib_protocol_environment/sigs/v1/block_header.mli diff --git a/src/lib_protocol_environment_sigs/v1/buffer.mli b/src/lib_protocol_environment/sigs/v1/buffer.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/buffer.mli rename to src/lib_protocol_environment/sigs/v1/buffer.mli diff --git a/src/lib_protocol_environment_sigs/v1/bytes.mli b/src/lib_protocol_environment/sigs/v1/bytes.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/bytes.mli rename to src/lib_protocol_environment/sigs/v1/bytes.mli diff --git a/src/lib_protocol_environment_sigs/v1/compare.mli b/src/lib_protocol_environment/sigs/v1/compare.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/compare.mli rename to src/lib_protocol_environment/sigs/v1/compare.mli diff --git a/src/lib_protocol_environment_sigs/v1/context.mli b/src/lib_protocol_environment/sigs/v1/context.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/context.mli rename to src/lib_protocol_environment/sigs/v1/context.mli diff --git a/src/lib_protocol_environment_sigs/v1/context_hash.mli b/src/lib_protocol_environment/sigs/v1/context_hash.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/context_hash.mli rename to src/lib_protocol_environment/sigs/v1/context_hash.mli diff --git a/src/lib_protocol_environment_sigs/v1/data_encoding.mli b/src/lib_protocol_environment/sigs/v1/data_encoding.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/data_encoding.mli rename to src/lib_protocol_environment/sigs/v1/data_encoding.mli diff --git a/src/lib_protocol_environment_sigs/v1/ed25519.mli b/src/lib_protocol_environment/sigs/v1/ed25519.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/ed25519.mli rename to src/lib_protocol_environment/sigs/v1/ed25519.mli diff --git a/src/lib_protocol_environment_sigs/v1/error_monad.mli b/src/lib_protocol_environment/sigs/v1/error_monad.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/error_monad.mli rename to src/lib_protocol_environment/sigs/v1/error_monad.mli diff --git a/src/lib_protocol_environment_sigs/v1/fitness.mli b/src/lib_protocol_environment/sigs/v1/fitness.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/fitness.mli rename to src/lib_protocol_environment/sigs/v1/fitness.mli diff --git a/src/lib_protocol_environment_sigs/v1/format.mli b/src/lib_protocol_environment/sigs/v1/format.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/format.mli rename to src/lib_protocol_environment/sigs/v1/format.mli diff --git a/src/lib_protocol_environment_sigs/v1/int32.mli b/src/lib_protocol_environment/sigs/v1/int32.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/int32.mli rename to src/lib_protocol_environment/sigs/v1/int32.mli diff --git a/src/lib_protocol_environment_sigs/v1/int64.mli b/src/lib_protocol_environment/sigs/v1/int64.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/int64.mli rename to src/lib_protocol_environment/sigs/v1/int64.mli diff --git a/src/lib_protocol_environment_sigs/v1/json.mli b/src/lib_protocol_environment/sigs/v1/json.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/json.mli rename to src/lib_protocol_environment/sigs/v1/json.mli diff --git a/src/lib_protocol_environment_sigs/v1/list.mli b/src/lib_protocol_environment/sigs/v1/list.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/list.mli rename to src/lib_protocol_environment/sigs/v1/list.mli diff --git a/src/lib_protocol_environment_sigs/v1/logging.mli b/src/lib_protocol_environment/sigs/v1/logging.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/logging.mli rename to src/lib_protocol_environment/sigs/v1/logging.mli diff --git a/src/lib_protocol_environment_sigs/v1/lwt.mli b/src/lib_protocol_environment/sigs/v1/lwt.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/lwt.mli rename to src/lib_protocol_environment/sigs/v1/lwt.mli diff --git a/src/lib_protocol_environment_sigs/v1/lwt_list.mli b/src/lib_protocol_environment/sigs/v1/lwt_list.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/lwt_list.mli rename to src/lib_protocol_environment/sigs/v1/lwt_list.mli diff --git a/src/lib_protocol_environment_sigs/v1/lwt_sequence.mli b/src/lib_protocol_environment/sigs/v1/lwt_sequence.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/lwt_sequence.mli rename to src/lib_protocol_environment/sigs/v1/lwt_sequence.mli diff --git a/src/lib_protocol_environment_sigs/v1/mBytes.mli b/src/lib_protocol_environment/sigs/v1/mBytes.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/mBytes.mli rename to src/lib_protocol_environment/sigs/v1/mBytes.mli diff --git a/src/lib_protocol_environment_sigs/v1/map.mli b/src/lib_protocol_environment/sigs/v1/map.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/map.mli rename to src/lib_protocol_environment/sigs/v1/map.mli diff --git a/src/lib_protocol_environment_sigs/v1/micheline.mli b/src/lib_protocol_environment/sigs/v1/micheline.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/micheline.mli rename to src/lib_protocol_environment/sigs/v1/micheline.mli diff --git a/src/lib_protocol_environment_sigs/v1/operation.mli b/src/lib_protocol_environment/sigs/v1/operation.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/operation.mli rename to src/lib_protocol_environment/sigs/v1/operation.mli diff --git a/src/lib_protocol_environment_sigs/v1/operation_hash.mli b/src/lib_protocol_environment/sigs/v1/operation_hash.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/operation_hash.mli rename to src/lib_protocol_environment/sigs/v1/operation_hash.mli diff --git a/src/lib_protocol_environment_sigs/v1/operation_list_hash.mli b/src/lib_protocol_environment/sigs/v1/operation_list_hash.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/operation_list_hash.mli rename to src/lib_protocol_environment/sigs/v1/operation_list_hash.mli diff --git a/src/lib_protocol_environment_sigs/v1/operation_list_list_hash.mli b/src/lib_protocol_environment/sigs/v1/operation_list_list_hash.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/operation_list_list_hash.mli rename to src/lib_protocol_environment/sigs/v1/operation_list_list_hash.mli diff --git a/src/lib_protocol_environment_sigs/v1/option.mli b/src/lib_protocol_environment/sigs/v1/option.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/option.mli rename to src/lib_protocol_environment/sigs/v1/option.mli diff --git a/src/lib_protocol_environment_sigs/v1/pervasives.mli b/src/lib_protocol_environment/sigs/v1/pervasives.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/pervasives.mli rename to src/lib_protocol_environment/sigs/v1/pervasives.mli diff --git a/src/lib_protocol_environment_sigs/v1/protocol.mli b/src/lib_protocol_environment/sigs/v1/protocol.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/protocol.mli rename to src/lib_protocol_environment/sigs/v1/protocol.mli diff --git a/src/lib_protocol_environment_sigs/v1/protocol_hash.mli b/src/lib_protocol_environment/sigs/v1/protocol_hash.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/protocol_hash.mli rename to src/lib_protocol_environment/sigs/v1/protocol_hash.mli diff --git a/src/lib_protocol_environment_sigs/v1/s.mli b/src/lib_protocol_environment/sigs/v1/s.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/s.mli rename to src/lib_protocol_environment/sigs/v1/s.mli diff --git a/src/lib_protocol_environment_sigs/v1/set.mli b/src/lib_protocol_environment/sigs/v1/set.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/set.mli rename to src/lib_protocol_environment/sigs/v1/set.mli diff --git a/src/lib_protocol_environment_sigs/v1/string.mli b/src/lib_protocol_environment/sigs/v1/string.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/string.mli rename to src/lib_protocol_environment/sigs/v1/string.mli diff --git a/src/lib_protocol_environment_sigs/v1/tezos_data.mli b/src/lib_protocol_environment/sigs/v1/tezos_data.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/tezos_data.mli rename to src/lib_protocol_environment/sigs/v1/tezos_data.mli diff --git a/src/lib_protocol_environment_sigs/v1/time.mli b/src/lib_protocol_environment/sigs/v1/time.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/time.mli rename to src/lib_protocol_environment/sigs/v1/time.mli diff --git a/src/lib_protocol_environment_sigs/v1/updater.mli b/src/lib_protocol_environment/sigs/v1/updater.mli similarity index 96% rename from src/lib_protocol_environment_sigs/v1/updater.mli rename to src/lib_protocol_environment/sigs/v1/updater.mli index 15c37e7fa..ffd2971df 100644 --- a/src/lib_protocol_environment_sigs/v1/updater.mli +++ b/src/lib_protocol_environment/sigs/v1/updater.mli @@ -158,12 +158,6 @@ module type PROTOCOL = sig end -(** Takes a version hash, a list of OCaml components in compilation - order. The last element must be named [protocol] and respect the - [protocol.ml] interface. Tries to compile it and returns true - if the operation was successful. *) -val compile: Protocol_hash.t -> Protocol.t -> bool Lwt.t - (** Activates a given protocol version from a given context. This means that the context used for the next block will use this version (this is not an immediate change). The version must have diff --git a/src/lib_protocol_environment_sigs/v1/z.mli b/src/lib_protocol_environment/sigs/v1/z.mli similarity index 100% rename from src/lib_protocol_environment_sigs/v1/z.mli rename to src/lib_protocol_environment/sigs/v1/z.mli diff --git a/src/lib_protocol_environment_sigs/sigs_packer/jbuild b/src/lib_protocol_environment/sigs_packer/jbuild similarity index 64% rename from src/lib_protocol_environment_sigs/sigs_packer/jbuild rename to src/lib_protocol_environment/sigs_packer/jbuild index 50cc94ae3..bd798f884 100644 --- a/src/lib_protocol_environment_sigs/sigs_packer/jbuild +++ b/src/lib_protocol_environment/sigs_packer/jbuild @@ -2,7 +2,8 @@ (executable ((name sigs_packer) - (public_name tezos-protocol-environment-sigs.packer))) + (public_name tezos-protocol-environment-sigs.packer) + (package tezos-protocol-environment-sigs))) (alias ((name runtest_indent) diff --git a/src/lib_protocol_environment_sigs/sigs_packer/sigs_packer.ml b/src/lib_protocol_environment/sigs_packer/sigs_packer.ml similarity index 100% rename from src/lib_protocol_environment_sigs/sigs_packer/sigs_packer.ml rename to src/lib_protocol_environment/sigs_packer/sigs_packer.ml diff --git a/src/lib_protocol_environment_client/test/assert.ml b/src/lib_protocol_environment/test/assert.ml similarity index 100% rename from src/lib_protocol_environment_client/test/assert.ml rename to src/lib_protocol_environment/test/assert.ml diff --git a/src/lib_protocol_environment_client/test/jbuild b/src/lib_protocol_environment/test/jbuild similarity index 77% rename from src/lib_protocol_environment_client/test/jbuild rename to src/lib_protocol_environment/test/jbuild index ea352f768..b4313912c 100644 --- a/src/lib_protocol_environment_client/test/jbuild +++ b/src/lib_protocol_environment/test/jbuild @@ -3,12 +3,12 @@ (executables ((names (test)) (libraries (tezos-base - tezos-protocol-environment-client + tezos-protocol-environment alcotest-lwt)) (flags (:standard -w -9-32 -safe-string -open Tezos_base__TzPervasives - -open Tezos_protocol_environment_client)))) + -open Tezos_protocol_environment)))) (alias ((name buildtest) @@ -16,6 +16,7 @@ (alias ((name runtest) + (package tezos-protocol-environment) (action (run ${exe:test.exe})))) (alias diff --git a/src/lib_protocol_environment_client/test/test.ml b/src/lib_protocol_environment/test/test.ml similarity index 92% rename from src/lib_protocol_environment_client/test/test.ml rename to src/lib_protocol_environment/test/test.ml index ac06cc480..f2144bc19 100644 --- a/src/lib_protocol_environment_client/test/test.ml +++ b/src/lib_protocol_environment/test/test.ml @@ -8,6 +8,6 @@ (**************************************************************************) let () = - Alcotest.run "tezos-protocol-environment-client" [ + Alcotest.run "tezos-protocol-environment-shell" [ "mem_context", Test_mem_context.tests ; ] diff --git a/src/lib_protocol_environment_client/test/test_mem_context.ml b/src/lib_protocol_environment/test/test_mem_context.ml similarity index 61% rename from src/lib_protocol_environment_client/test/test_mem_context.ml rename to src/lib_protocol_environment/test/test_mem_context.ml index 229447685..fb28d2023 100644 --- a/src/lib_protocol_environment_client/test/test_mem_context.ml +++ b/src/lib_protocol_environment/test/test_mem_context.ml @@ -7,35 +7,35 @@ (* *) (**************************************************************************) -open Mem_context +open Tezos_protocol_environment_memory (** Context creation *) let create_block2 ctxt = - set ctxt ["a"; "b"] (MBytes.of_string "Novembre") >>= fun ctxt -> - set ctxt ["a"; "c"] (MBytes.of_string "Juin") >>= fun ctxt -> - set ctxt ["version";] (MBytes.of_string "0.0") >>= fun ctxt -> + Context.set ctxt ["a"; "b"] (MBytes.of_string "Novembre") >>= fun ctxt -> + Context.set ctxt ["a"; "c"] (MBytes.of_string "Juin") >>= fun ctxt -> + Context.set ctxt ["version";] (MBytes.of_string "0.0") >>= fun ctxt -> Lwt.return ctxt let create_block3a ctxt = - del ctxt ["a"; "b"] >>= fun ctxt -> - set ctxt ["a"; "d"] (MBytes.of_string "Mars") >>= fun ctxt -> + Context.del ctxt ["a"; "b"] >>= fun ctxt -> + Context.set ctxt ["a"; "d"] (MBytes.of_string "Mars") >>= fun ctxt -> Lwt.return ctxt let create_block3b ctxt = - del ctxt ["a"; "c"] >>= fun ctxt -> - set ctxt ["a"; "d"] (MBytes.of_string "Février") >>= fun ctxt -> + Context.del ctxt ["a"; "c"] >>= fun ctxt -> + Context.set ctxt ["a"; "d"] (MBytes.of_string "Février") >>= fun ctxt -> Lwt.return ctxt type t = { - genesis: Mem_context.t ; - block2: Mem_context.t ; - block3a: Mem_context.t ; - block3b: Mem_context.t ; + genesis: Context.t ; + block2: Context.t ; + block3a: Context.t ; + block3b: Context.t ; } let wrap_context_init f _ () = - let genesis = Mem_context.empty in + let genesis = Context.empty in create_block2 genesis >>= fun block2 -> create_block3a block2 >>= fun block3a -> create_block3b block2 >>= fun block3b -> @@ -49,58 +49,58 @@ let c = function | Some s -> Some (MBytes.to_string s) let test_simple { block2 = ctxt } = - get ctxt ["version"] >>= fun version -> + Context.get ctxt ["version"] >>= fun version -> Assert.equal_string_option ~msg:__LOC__ (c version) (Some "0.0") ; - get ctxt ["a";"b"] >>= fun novembre -> + Context.get ctxt ["a";"b"] >>= fun novembre -> Assert.equal_string_option (Some "Novembre") (c novembre) ; - get ctxt ["a";"c"] >>= fun juin -> + Context.get ctxt ["a";"c"] >>= fun juin -> Assert.equal_string_option ~msg:__LOC__ (Some "Juin") (c juin) ; Lwt.return () let test_continuation { block3a = ctxt } = - get ctxt ["version"] >>= fun version -> + Context.get ctxt ["version"] >>= fun version -> Assert.equal_string_option ~msg:__LOC__ (Some "0.0") (c version) ; - get ctxt ["a";"b"] >>= fun novembre -> + Context.get ctxt ["a";"b"] >>= fun novembre -> Assert.is_none ~msg:__LOC__ (c novembre) ; - get ctxt ["a";"c"] >>= fun juin -> + Context.get ctxt ["a";"c"] >>= fun juin -> Assert.equal_string_option ~msg:__LOC__ (Some "Juin") (c juin) ; - get ctxt ["a";"d"] >>= fun mars -> + Context.get ctxt ["a";"d"] >>= fun mars -> Assert.equal_string_option ~msg:__LOC__ (Some "Mars") (c mars) ; Lwt.return () let test_fork { block3b = ctxt } = - get ctxt ["version"] >>= fun version -> + Context.get ctxt ["version"] >>= fun version -> Assert.equal_string_option ~msg:__LOC__ (Some "0.0") (c version) ; - get ctxt ["a";"b"] >>= fun novembre -> + Context.get ctxt ["a";"b"] >>= fun novembre -> Assert.equal_string_option ~msg:__LOC__ (Some "Novembre") (c novembre) ; - get ctxt ["a";"c"] >>= fun juin -> + Context.get ctxt ["a";"c"] >>= fun juin -> Assert.is_none ~msg:__LOC__ (c juin) ; - get ctxt ["a";"d"] >>= fun mars -> + Context.get ctxt ["a";"d"] >>= fun mars -> Assert.equal_string_option ~msg:__LOC__ (Some "Février") (c mars) ; Lwt.return () let test_replay { genesis = ctxt0 } = - set ctxt0 ["version"] (MBytes.of_string "0.0") >>= fun ctxt1 -> - set ctxt1 ["a"; "b"] (MBytes.of_string "Novembre") >>= fun ctxt2 -> - set ctxt2 ["a"; "c"] (MBytes.of_string "Juin") >>= fun ctxt3 -> - set ctxt3 ["a"; "d"] (MBytes.of_string "July") >>= fun ctxt4a -> - set ctxt3 ["a"; "d"] (MBytes.of_string "Juillet") >>= fun ctxt4b -> - set ctxt4a ["a"; "b"] (MBytes.of_string "November") >>= fun ctxt5a -> - get ctxt4a ["a";"b"] >>= fun novembre -> + Context.set ctxt0 ["version"] (MBytes.of_string "0.0") >>= fun ctxt1 -> + Context.set ctxt1 ["a"; "b"] (MBytes.of_string "Novembre") >>= fun ctxt2 -> + Context.set ctxt2 ["a"; "c"] (MBytes.of_string "Juin") >>= fun ctxt3 -> + Context.set ctxt3 ["a"; "d"] (MBytes.of_string "July") >>= fun ctxt4a -> + Context.set ctxt3 ["a"; "d"] (MBytes.of_string "Juillet") >>= fun ctxt4b -> + Context.set ctxt4a ["a"; "b"] (MBytes.of_string "November") >>= fun ctxt5a -> + Context.get ctxt4a ["a";"b"] >>= fun novembre -> Assert.equal_string_option ~msg:__LOC__ (Some "Novembre") (c novembre) ; - get ctxt5a ["a";"b"] >>= fun november -> + Context.get ctxt5a ["a";"b"] >>= fun november -> Assert.equal_string_option ~msg:__LOC__ (Some "November") (c november) ; - get ctxt5a ["a";"d"] >>= fun july -> + Context.get ctxt5a ["a";"d"] >>= fun july -> Assert.equal_string_option ~msg:__LOC__ (Some "July") (c july) ; - get ctxt4b ["a";"b"] >>= fun novembre -> + Context.get ctxt4b ["a";"b"] >>= fun novembre -> Assert.equal_string_option ~msg:__LOC__ (Some "Novembre") (c novembre) ; - get ctxt4b ["a";"d"] >>= fun juillet -> + Context.get ctxt4b ["a";"d"] >>= fun juillet -> Assert.equal_string_option ~msg:__LOC__ (Some "Juillet") (c juillet) ; Lwt.return () let fold_keys s k ~init ~f = let rec loop k acc = - fold s k ~init:acc + Context.fold s k ~init:acc ~f:(fun file acc -> match file with | `Key k -> f k acc @@ -109,11 +109,11 @@ let fold_keys s k ~init ~f = let keys t = fold_keys t ~init:[] ~f:(fun k acc -> Lwt.return (k :: acc)) let test_fold { genesis = ctxt } = - set ctxt ["a"; "b"] (MBytes.of_string "Novembre") >>= fun ctxt -> - set ctxt ["a"; "c"] (MBytes.of_string "Juin") >>= fun ctxt -> - set ctxt ["a"; "d"; "e"] (MBytes.of_string "Septembre") >>= fun ctxt -> - set ctxt ["f";] (MBytes.of_string "Avril") >>= fun ctxt -> - set ctxt ["g"; "h"] (MBytes.of_string "Avril") >>= fun ctxt -> + Context.set ctxt ["a"; "b"] (MBytes.of_string "Novembre") >>= fun ctxt -> + Context.set ctxt ["a"; "c"] (MBytes.of_string "Juin") >>= fun ctxt -> + Context.set ctxt ["a"; "d"; "e"] (MBytes.of_string "Septembre") >>= fun ctxt -> + Context.set ctxt ["f";] (MBytes.of_string "Avril") >>= fun ctxt -> + Context.set ctxt ["g"; "h"] (MBytes.of_string "Avril") >>= fun ctxt -> keys ctxt [] >>= fun l -> Assert.equal_string_list_list ~msg:__LOC__ [["a";"b"]; diff --git a/src/lib_protocol_environment/tezos-protocol-environment-shell.opam b/src/lib_protocol_environment/tezos-protocol-environment-shell.opam new file mode 100644 index 000000000..c5acb71a5 --- /dev/null +++ b/src/lib_protocol_environment/tezos-protocol-environment-shell.opam @@ -0,0 +1,21 @@ +opam-version: "1.2" +version: "dev" +maintainer: "contact@tezos.com" +authors: [ "Tezos devteam" ] +homepage: "https://www.tezos.com/" +bug-reports: "https://gitlab.com/tezos/tezos/issues" +dev-repo: "https://gitlab.com/tezos/tezos.git" +license: "unreleased" +depends: [ + "ocamlfind" { build } + "jbuilder" { build & >= "1.0+beta17" } + "tezos-base" + "tezos-protocol-environment" + "tezos-storage" +] +build: [ + [ "jbuilder" "build" "-p" name "-j" jobs ] +] +build-test: [ + [ "jbuilder" "runtest" "-p" name "-j" jobs ] +] diff --git a/src/lib_protocol_environment_sigs/tezos-protocol-environment-sigs.opam b/src/lib_protocol_environment/tezos-protocol-environment-sigs.opam similarity index 100% rename from src/lib_protocol_environment_sigs/tezos-protocol-environment-sigs.opam rename to src/lib_protocol_environment/tezos-protocol-environment-sigs.opam diff --git a/src/lib_protocol_environment_client/tezos-protocol-environment-client.opam b/src/lib_protocol_environment/tezos-protocol-environment.opam similarity index 96% rename from src/lib_protocol_environment_client/tezos-protocol-environment-client.opam rename to src/lib_protocol_environment/tezos-protocol-environment.opam index 9ba0d3f28..34df44af8 100644 --- a/src/lib_protocol_environment_client/tezos-protocol-environment-client.opam +++ b/src/lib_protocol_environment/tezos-protocol-environment.opam @@ -10,7 +10,6 @@ depends: [ "ocamlfind" { build } "jbuilder" { build & >= "1.0+beta17" } "tezos-base" - "tezos-micheline" "tezos-protocol-environment-sigs" "alcotest-lwt" { test } ] diff --git a/src/lib_protocol_environment/tezos_protocol_environment.ml b/src/lib_protocol_environment/tezos_protocol_environment.ml new file mode 100644 index 000000000..8e0f1d6ab --- /dev/null +++ b/src/lib_protocol_environment/tezos_protocol_environment.ml @@ -0,0 +1,563 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Error_monad + +module type CONTEXT = sig + type t + type key = string list + type value = MBytes.t + val mem: t -> key -> bool Lwt.t + val dir_mem: t -> key -> bool Lwt.t + val get: t -> key -> value option Lwt.t + val set: t -> key -> value -> t Lwt.t + val del: t -> key -> t Lwt.t + val remove_rec: t -> key -> t Lwt.t + val fold: + t -> key -> init:'a -> + f:([ `Key of key | `Dir of key ] -> 'a -> 'a Lwt.t) -> + 'a Lwt.t + val set_protocol: t -> Protocol_hash.t -> t Lwt.t + val fork_test_chain: + t -> protocol:Protocol_hash.t -> expiration:Time.t -> t Lwt.t +end + +module Make (Context : CONTEXT) = struct + + type validation_result = { + context: Context.t ; + fitness: Fitness.t ; + message: string option ; + max_operation_data_length: int ; + max_operations_ttl: int ; + } + + type quota = { + max_size: int ; + max_op: int option ; + } + + type rpc_context = { + block_hash: Block_hash.t ; + block_header: Block_header.t ; + operation_hashes: unit -> Operation_hash.t list list Lwt.t ; + operations: unit -> Operation.t list list Lwt.t ; + context: Context.t ; + } + + module type T = sig + type context + type quota + type validation_result + type rpc_context + type 'a tzresult + val max_block_length: int + val validation_passes: quota list + type operation + val parse_operation: + Operation_hash.t -> Operation.t -> operation tzresult + val acceptable_passes: operation -> int list + val compare_operations: operation -> operation -> int + type validation_state + val current_context: validation_state -> context tzresult Lwt.t + val precheck_block: + ancestor_context: context -> + ancestor_timestamp: Time.t -> + Block_header.t -> + unit tzresult Lwt.t + val begin_application: + predecessor_context: context -> + predecessor_timestamp: Time.t -> + predecessor_fitness: Fitness.t -> + Block_header.t -> + validation_state tzresult Lwt.t + val begin_construction: + predecessor_context: context -> + predecessor_timestamp: Time.t -> + predecessor_level: Int32.t -> + predecessor_fitness: Fitness.t -> + predecessor: Block_hash.t -> + timestamp: Time.t -> + ?protocol_data: MBytes.t -> + unit -> validation_state tzresult Lwt.t + val apply_operation: + validation_state -> operation -> validation_state tzresult Lwt.t + val finalize_block: + validation_state -> validation_result tzresult Lwt.t + val rpc_services: rpc_context Lwt.t RPC_directory.t + val configure_sandbox: + context -> Data_encoding.json option -> context tzresult Lwt.t + end + + module type PROTOCOL = + T with type context := Context.t + and type quota := quota + and type validation_result := validation_result + and type rpc_context := rpc_context + and type 'a tzresult := 'a Error_monad.tzresult + + module type V1 = sig + + include Tezos_protocol_environment_sigs.V1.T + with type Format.formatter = Format.formatter + and type 'a Data_encoding.t = 'a Data_encoding.t + and type 'a Lwt.t = 'a Lwt.t + and type ('a, 'b) Pervasives.result = ('a, 'b) result + and type Block_hash.t = Block_hash.t + and type Operation_hash.t = Operation_hash.t + and type Operation_list_hash.t = Operation_list_hash.t + and type Operation_list_list_hash.t = Operation_list_list_hash.t + and type Context.t = Context.t + and type Context_hash.t = Context_hash.t + and type Protocol_hash.t = Protocol_hash.t + and type Time.t = Time.t + and type MBytes.t = MBytes.t + and type Operation.shell_header = Operation.shell_header + and type Operation.t = Operation.t + and type Block_header.shell_header = Block_header.shell_header + and type Block_header.t = Block_header.t + and type 'a RPC_directory.t = 'a RPC_directory.t + and type Ed25519.Public_key_hash.t = Ed25519.Public_key_hash.t + and type Ed25519.Public_key.t = Ed25519.Public_key.t + and type Ed25519.Secret_key.t = Ed25519.Secret_key.t + and type Ed25519.Signature.t = Ed25519.Signature.t + and type 'a Micheline.canonical = 'a Micheline.canonical + and type ('a, 'b) RPC_path.t = ('a, 'b) RPC_path.t + and type ('a, 'b) Micheline.node = ('a, 'b) Micheline.node + and type Data_encoding.json_schema = Data_encoding.json_schema + and type RPC_service.meth = RPC_service.meth + and type (+'m,'pr,'p,'q,'i,'o) RPC_service.t = ('m,'pr,'p,'q,'i,'o) RPC_service.t + and type Error_monad.shell_error = Error_monad.error + + type error += Ecoproto_error of Error_monad.error list + val wrap_error : 'a Error_monad.tzresult -> 'a tzresult + + module Lift (P : Updater.PROTOCOL) : PROTOCOL + + class ['block] proto_rpc_context : + Tezos_rpc.RPC_context.t -> (unit, unit * 'block) RPC_path.t -> + ['block] RPC_context.simple + + class ['block] proto_rpc_context_of_directory : + ('block -> RPC_context.t) -> RPC_context.t RPC_directory.t -> + ['block] RPC_context.simple + + end + + module MakeV1 (Param : sig val name: string end) () = struct + + include Pervasives + module Pervasives = Pervasives + module Compare = Compare + module Array = Array + module List = List + module Bytes = struct + include Bytes + include EndianBytes.BigEndian + module LE = EndianBytes.LittleEndian + end + module String = struct + include String + include EndianString.BigEndian + module LE = EndianString.LittleEndian + end + module Set = Set + module Map = Map + module Int32 = Int32 + module Int64 = Int64 + module Nativeint = Nativeint + module Buffer = Buffer + module Format = Format + module Option = Option + module Z = Z + module Lwt_sequence = Lwt_sequence + module Lwt = Lwt + module Lwt_list = Lwt_list + module MBytes = MBytes + module Uri = Uri + module Data_encoding = Data_encoding + module Time = Time + module Ed25519 = Ed25519 + module S = Tezos_base.S + module Error_monad = struct + type 'a shell_tzresult = 'a Error_monad.tzresult + type shell_error = Error_monad.error = .. + type error_category = [ `Branch | `Temporary | `Permanent ] + include Error_monad.Make() + end + + type error += Ecoproto_error of Error_monad.error list + + let () = + let id = Format.asprintf "Ecoproto.%s" Param.name in + register_wrapped_error_kind + (fun ecoerrors -> Error_monad.classify_errors ecoerrors) + ~id ~title:"Error returned by the protocol" + ~description:"Wrapped error for the economic protocol." + ~pp:(fun ppf -> + Format.fprintf ppf + "@[Economic error:@ %a@]" + (Format.pp_print_list Error_monad.pp)) + Data_encoding.(obj1 (req "ecoproto" + (list Error_monad.error_encoding))) + (function Ecoproto_error ecoerrors -> Some ecoerrors + | _ -> None ) + (function ecoerrors -> Ecoproto_error ecoerrors) + + let wrap_error = function + | Ok _ as ok -> ok + | Error errors -> Error [Ecoproto_error errors] + + module Block_hash = Block_hash + module Operation_hash = Operation_hash + module Operation_list_hash = Operation_list_hash + module Operation_list_list_hash = Operation_list_list_hash + module Context_hash = Context_hash + module Protocol_hash = Protocol_hash + module Blake2B = Tezos_base.Blake2B + module Fitness = Fitness + module Operation = Operation + module Block_header = Block_header + module Protocol = Protocol + module RPC_arg = RPC_arg + module RPC_path = RPC_path + module RPC_query = RPC_query + module RPC_service = RPC_service + module RPC_answer = struct + + type 'o t = + [ `Ok of 'o (* 200 *) + | `OkStream of 'o stream (* 200 *) + | `Created of string option (* 201 *) + | `No_content (* 204 *) + | `Unauthorized of Error_monad.error list option (* 401 *) + | `Forbidden of Error_monad.error list option (* 403 *) + | `Not_found of Error_monad.error list option (* 404 *) + | `Conflict of Error_monad.error list option (* 409 *) + | `Error of Error_monad.error list option (* 500 *) + ] + + and 'a stream = 'a Resto_directory.Answer.stream = { + next: unit -> 'a option Lwt.t ; + shutdown: unit -> unit ; + } + + let return x = Lwt.return (`Ok x) + let return_stream x = Lwt.return (`OkStream x) + let not_found = Lwt.return (`Not_found None) + + let fail err = Lwt.return (`Error (Some err)) + end + module RPC_directory = struct + include RPC_directory + let gen_register dir service handler = + gen_register dir service + (fun p q i -> + handler p q i >>= function + | `Ok o -> RPC_answer.return o + | `OkStream s -> RPC_answer.return_stream s + | `Created s -> Lwt.return (`Created s) + | `No_content -> Lwt.return (`No_content) + | `Unauthorized e -> + let e = Option.map e ~f:(fun e -> [Ecoproto_error e]) in + Lwt.return (`Unauthorized e) + | `Forbidden e -> + let e = Option.map e ~f:(fun e -> [Ecoproto_error e]) in + Lwt.return (`Forbidden e) + | `Not_found e -> + let e = Option.map e ~f:(fun e -> [Ecoproto_error e]) in + Lwt.return (`Not_found e) + | `Conflict e -> + let e = Option.map e ~f:(fun e -> [Ecoproto_error e]) in + Lwt.return (`Conflict e) + | `Error e -> + let e = Option.map e ~f:(fun e -> [Ecoproto_error e]) in + Lwt.return (`Error e)) + + let register dir service handler = + gen_register dir service + (fun p q i -> + handler p q i >>= function + | Ok o -> RPC_answer.return o + | Error e -> RPC_answer.fail e) + + let lwt_register dir service handler = + gen_register dir service + (fun p q i -> + handler p q i >>= fun o -> + RPC_answer.return o) + + open Curry + + let register0 root s f = register root s (curry Z f) + let register1 root s f = register root s (curry (S Z) f) + let register2 root s f = register root s (curry (S (S Z)) f) + let register3 root s f = register root s (curry (S (S (S Z))) f) + let register4 root s f = register root s (curry (S (S (S (S Z)))) f) + let register5 root s f = register root s (curry (S (S (S (S (S Z))))) f) + + let gen_register0 root s f = gen_register root s (curry Z f) + let gen_register1 root s f = gen_register root s (curry (S Z) f) + let gen_register2 root s f = gen_register root s (curry (S (S Z)) f) + let gen_register3 root s f = gen_register root s (curry (S (S (S Z))) f) + let gen_register4 root s f = gen_register root s (curry (S (S (S (S Z)))) f) + let gen_register5 root s f = gen_register root s (curry (S (S (S (S (S Z))))) f) + + let lwt_register0 root s f = lwt_register root s (curry Z f) + let lwt_register1 root s f = lwt_register root s (curry (S Z) f) + let lwt_register2 root s f = lwt_register root s (curry (S (S Z)) f) + let lwt_register3 root s f = lwt_register root s (curry (S (S (S Z))) f) + let lwt_register4 root s f = lwt_register root s (curry (S (S (S (S Z)))) f) + let lwt_register5 root s f = lwt_register root s (curry (S (S (S (S (S Z))))) f) + + end + module RPC_context = struct + + type t = rpc_context Lwt.t + + class type ['pr] simple = object + method call_proto_service0 : + 'm 'q 'i 'o. + ([< RPC_service.meth ] as 'm, t, t, 'q, 'i, 'o) RPC_service.t -> + 'pr -> 'q -> 'i -> 'o Error_monad.shell_tzresult Lwt.t + method call_proto_service1 : + 'm 'a 'q 'i 'o. + ([< RPC_service.meth ] as 'm, t, t * 'a, 'q, 'i, 'o) RPC_service.t -> + 'pr -> 'a -> 'q -> 'i -> 'o Error_monad.shell_tzresult Lwt.t + method call_proto_service2 : + 'm 'a 'b 'q 'i 'o. + ([< RPC_service.meth ] as 'm, t, (t * 'a) * 'b, 'q, 'i, 'o) RPC_service.t -> + 'pr -> 'a -> 'b -> 'q -> 'i -> 'o Error_monad.shell_tzresult Lwt.t + method call_proto_service3 : + 'm 'a 'b 'c 'q 'i 'o. + ([< RPC_service.meth ] as 'm, t, ((t * 'a) * 'b) * 'c, 'q, 'i, 'o) RPC_service.t -> + 'pr -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o Error_monad.shell_tzresult Lwt.t + end + + let make_call0 s (ctxt : _ simple) = + ctxt#call_proto_service0 s + let make_call0 = (make_call0 : _ -> _ simple -> _ :> _ -> _ #simple -> _) + + let make_call1 s (ctxt: _ simple) = + ctxt#call_proto_service1 s + let make_call1 = (make_call1 : _ -> _ simple -> _ :> _ -> _ #simple -> _) + + let make_call2 s (ctxt: _ simple) = + ctxt#call_proto_service2 s + let make_call2 = (make_call2 : _ -> _ simple -> _ :> _ -> _ #simple -> _) + + let make_call3 s (ctxt: _ simple) = + ctxt#call_proto_service3 s + let make_call3 = (make_call3 : _ -> _ simple -> _ :> _ -> _ #simple -> _) + + let make_opt_call0 s ctxt block q i = + make_call0 s ctxt block q i >>= function + | Error [RPC_context.Not_found _] -> Lwt.return (Ok None) + | Error _ as v -> Lwt.return v + | Ok v -> Lwt.return (Ok (Some v)) + + let make_opt_call1 s ctxt block a1 q i = + make_call1 s ctxt block a1 q i >>= function + | Error [RPC_context.Not_found _] -> Lwt.return (Ok None) + | Error _ as v -> Lwt.return v + | Ok v -> Lwt.return (Ok (Some v)) + + let make_opt_call2 s ctxt block a1 a2 q i = + make_call2 s ctxt block a1 a2 q i >>= function + | Error [RPC_context.Not_found _] -> Lwt.return (Ok None) + | Error _ as v -> Lwt.return v + | Ok v -> Lwt.return (Ok (Some v)) + + let make_opt_call3 s ctxt block a1 a2 a3 q i = + make_call3 s ctxt block a1 a2 a3 q i >>= function + | Error [RPC_context.Not_found _] -> Lwt.return (Ok None) + | Error _ as v -> Lwt.return v + | Ok v -> Lwt.return (Ok (Some v)) + + end + module Micheline = Micheline + module Logging = Logging.Make(Param) + + module Updater = struct + + type nonrec validation_result = validation_result = { + context: Context.t ; + fitness: Fitness.t ; + message: string option ; + max_operation_data_length: int ; + max_operations_ttl: int ; + } + + type nonrec quota = quota = { + max_size: int ; + max_op: int option ; + } + + type nonrec rpc_context = rpc_context = { + block_hash: Block_hash.t ; + block_header: Block_header.t ; + operation_hashes: unit -> Operation_hash.t list list Lwt.t ; + operations: unit -> Operation.t list list Lwt.t ; + context: Context.t ; + } + + let activate = Context.set_protocol + let fork_test_chain = Context.fork_test_chain + + module type PROTOCOL = + T with type context := Context.t + and type quota := quota + and type validation_result := validation_result + and type rpc_context := rpc_context + and type 'a tzresult := 'a Error_monad.tzresult + + end + module Base58 = struct + include Tezos_crypto.Base58 + let simple_encode enc s = simple_encode enc s + let simple_decode enc s = simple_decode enc s + include Make(struct type context = Context.t end) + let decode s = decode s + end + module Context = struct + include Context + + let fold_keys s k ~init ~f = + let rec loop k acc = + fold s k ~init:acc + ~f:(fun file acc -> + match file with + | `Key k -> f k acc + | `Dir k -> loop k acc) in + loop k init + + let keys t = fold_keys t ~init:[] ~f:(fun k acc -> Lwt.return (k :: acc)) + + let register_resolver = Base58.register_resolver + let complete ctxt s = Base58.complete ctxt s + end + + module Lift(P : Updater.PROTOCOL) = struct + include P + let precheck_block + ~ancestor_context ~ancestor_timestamp + raw_block = + precheck_block + ~ancestor_context ~ancestor_timestamp + raw_block >|= wrap_error + let begin_application + ~predecessor_context ~predecessor_timestamp + ~predecessor_fitness + raw_block = + begin_application + ~predecessor_context ~predecessor_timestamp + ~predecessor_fitness + raw_block >|= wrap_error + let begin_construction + ~predecessor_context ~predecessor_timestamp + ~predecessor_level ~predecessor_fitness + ~predecessor ~timestamp ?protocol_data () = + begin_construction + ~predecessor_context ~predecessor_timestamp + ~predecessor_level ~predecessor_fitness + ~predecessor ~timestamp ?protocol_data () >|= wrap_error + let current_context c = + current_context c >|= wrap_error + let apply_operation c o = + apply_operation c o >|= wrap_error + let finalize_block c = finalize_block c >|= wrap_error + let parse_operation h b = parse_operation h b |> wrap_error + let configure_sandbox c j = + configure_sandbox c j >|= wrap_error + end + + class ['block] proto_rpc_context + (t : Tezos_rpc.RPC_context.t) + (prefix : (unit, unit * 'block) RPC_path.t) = + object + method call_proto_service0 + : 'm 'q 'i 'o. + ([< RPC_service.meth ] as 'm, RPC_context.t, + RPC_context.t, 'q, 'i, 'o) RPC_service.t -> + 'block -> 'q -> 'i -> 'o tzresult Lwt.t + = fun s block q i -> + let s = RPC_service.subst0 s in + let s = RPC_service.prefix prefix s in + t#call_service s ((), block) q i + method call_proto_service1 + : 'm 'a 'q 'i 'o. + ([< RPC_service.meth ] as 'm, RPC_context.t, + RPC_context.t * 'a, 'q, 'i, 'o) RPC_service.t -> + 'block -> 'a -> 'q -> 'i -> 'o tzresult Lwt.t + = fun s block a1 q i -> + let s = RPC_service.subst1 s in + let s = RPC_service.prefix prefix s in + t#call_service s (((), block), a1) q i + method call_proto_service2 + : 'm 'a 'b 'q 'i 'o. + ([< RPC_service.meth ] as 'm, RPC_context.t, + (RPC_context.t * 'a) * 'b, 'q, 'i, 'o) RPC_service.t -> + 'block -> 'a -> 'b -> 'q -> 'i -> 'o tzresult Lwt.t + = fun s block a1 a2 q i -> + let s = RPC_service.subst2 s in + let s = RPC_service.prefix prefix s in + t#call_service s ((((), block), a1), a2) q i + method call_proto_service3 + : 'm 'a 'b 'c 'q 'i 'o. + ([< RPC_service.meth ] as 'm, RPC_context.t, + ((RPC_context.t * 'a) * 'b) * 'c, + 'q, 'i, 'o) RPC_service.t -> + 'block -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o tzresult Lwt.t + = fun s block a1 a2 a3 q i -> + let s = RPC_service.subst3 s in + let s = RPC_service.prefix prefix s in + t#call_service s (((((), block), a1), a2), a3) q i + end + + class ['block] proto_rpc_context_of_directory conv dir : ['block] RPC_context.simple = + let lookup = new Tezos_rpc.RPC_context.of_directory dir in + object + method call_proto_service0 + : 'm 'q 'i 'o. + ([< RPC_service.meth ] as 'm, RPC_context.t, + RPC_context.t, 'q, 'i, 'o) RPC_service.t -> + 'block -> 'q -> 'i -> 'o tzresult Lwt.t + = fun s block q i -> + let rpc_context = conv block in + lookup#call_service s rpc_context q i + method call_proto_service1 + : 'm 'a 'q 'i 'o. + ([< RPC_service.meth ] as 'm, RPC_context.t, + RPC_context.t * 'a, 'q, 'i, 'o) RPC_service.t -> + 'block -> 'a -> 'q -> 'i -> 'o tzresult Lwt.t + = fun s block a1 q i -> + let rpc_context = conv block in + lookup#call_service s (rpc_context, a1) q i + method call_proto_service2 + : 'm 'a 'b 'q 'i 'o. + ([< RPC_service.meth ] as 'm, RPC_context.t, + (RPC_context.t * 'a) * 'b, 'q, 'i, 'o) RPC_service.t -> + 'block -> 'a -> 'b -> 'q -> 'i -> 'o tzresult Lwt.t + = fun s block a1 a2 q i -> + let rpc_context = conv block in + lookup#call_service s ((rpc_context, a1), a2) q i + method call_proto_service3 + : 'm 'a 'b 'c 'q 'i 'o. + ([< RPC_service.meth ] as 'm, RPC_context.t, + ((RPC_context.t * 'a) * 'b) * 'c, + 'q, 'i, 'o) RPC_service.t -> + 'block -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o tzresult Lwt.t + = fun s block a1 a2 a3 q i -> + let rpc_context = conv block in + lookup#call_service s (((rpc_context, a1), a2), a3) q i + end + + end + +end diff --git a/src/lib_protocol_environment/tezos_protocol_environment.mli b/src/lib_protocol_environment/tezos_protocol_environment.mli new file mode 100644 index 000000000..ad0222ebe --- /dev/null +++ b/src/lib_protocol_environment/tezos_protocol_environment.mli @@ -0,0 +1,152 @@ + +open Error_monad + + +module type CONTEXT = sig + type t + type key = string list + type value = MBytes.t + val mem: t -> key -> bool Lwt.t + val dir_mem: t -> key -> bool Lwt.t + val get: t -> key -> value option Lwt.t + val set: t -> key -> value -> t Lwt.t + val del: t -> key -> t Lwt.t + val remove_rec: t -> key -> t Lwt.t + val fold: + t -> key -> init:'a -> + f:([ `Key of key | `Dir of key ] -> 'a -> 'a Lwt.t) -> + 'a Lwt.t + val set_protocol: t -> Protocol_hash.t -> t Lwt.t + val fork_test_chain: + t -> protocol:Protocol_hash.t -> expiration:Time.t -> t Lwt.t +end + +module Make (Context : CONTEXT) : sig + + type validation_result = { + context: Context.t ; + fitness: Fitness.t ; + message: string option ; + max_operation_data_length: int ; + max_operations_ttl: int ; + } + + type quota = { + max_size: int ; + max_op: int option ; + } + + type rpc_context = { + block_hash: Block_hash.t ; + block_header: Block_header.t ; + operation_hashes: unit -> Operation_hash.t list list Lwt.t ; + operations: unit -> Operation.t list list Lwt.t ; + context: Context.t ; + } + + module type T = sig + type context + type quota + type validation_result + type rpc_context + type 'a tzresult + val max_block_length: int + val validation_passes: quota list + type operation + val parse_operation: + Operation_hash.t -> Operation.t -> operation tzresult + val acceptable_passes: operation -> int list + val compare_operations: operation -> operation -> int + type validation_state + val current_context: validation_state -> context tzresult Lwt.t + val precheck_block: + ancestor_context: context -> + ancestor_timestamp: Time.t -> + Block_header.t -> + unit tzresult Lwt.t + val begin_application: + predecessor_context: context -> + predecessor_timestamp: Time.t -> + predecessor_fitness: Fitness.t -> + Block_header.t -> + validation_state tzresult Lwt.t + val begin_construction: + predecessor_context: context -> + predecessor_timestamp: Time.t -> + predecessor_level: Int32.t -> + predecessor_fitness: Fitness.t -> + predecessor: Block_hash.t -> + timestamp: Time.t -> + ?protocol_data: MBytes.t -> + unit -> validation_state tzresult Lwt.t + val apply_operation: + validation_state -> operation -> validation_state tzresult Lwt.t + val finalize_block: + validation_state -> validation_result tzresult Lwt.t + val rpc_services: rpc_context Lwt.t RPC_directory.t + val configure_sandbox: + context -> Data_encoding.json option -> context tzresult Lwt.t + end + + module type PROTOCOL = + T with type context := Context.t + and type quota := quota + and type validation_result := validation_result + and type rpc_context := rpc_context + and type 'a tzresult := 'a Error_monad.tzresult + + module type V1 = sig + + include Tezos_protocol_environment_sigs.V1.T + with type Format.formatter = Format.formatter + and type 'a Data_encoding.t = 'a Data_encoding.t + and type 'a Lwt.t = 'a Lwt.t + and type ('a, 'b) Pervasives.result = ('a, 'b) result + and type Block_hash.t = Block_hash.t + and type Operation_hash.t = Operation_hash.t + and type Operation_list_hash.t = Operation_list_hash.t + and type Operation_list_list_hash.t = Operation_list_list_hash.t + and type Context.t = Context.t + and type Context_hash.t = Context_hash.t + and type Protocol_hash.t = Protocol_hash.t + and type Time.t = Time.t + and type MBytes.t = MBytes.t + and type Operation.shell_header = Operation.shell_header + and type Operation.t = Operation.t + and type Block_header.shell_header = Block_header.shell_header + and type Block_header.t = Block_header.t + and type 'a RPC_directory.t = 'a RPC_directory.t + and type Ed25519.Public_key_hash.t = Ed25519.Public_key_hash.t + and type Ed25519.Public_key.t = Ed25519.Public_key.t + and type Ed25519.Secret_key.t = Ed25519.Secret_key.t + and type Ed25519.Signature.t = Ed25519.Signature.t + and type 'a Micheline.canonical = 'a Micheline.canonical + and type ('a, 'b) Micheline.node = ('a, 'b) Micheline.node + and type Data_encoding.json_schema = Data_encoding.json_schema + and type ('a, 'b) RPC_path.t = ('a, 'b) RPC_path.t + and type RPC_service.meth = RPC_service.meth + and type (+'m,'pr,'p,'q,'i,'o) RPC_service.t = ('m,'pr,'p,'q,'i,'o) RPC_service.t + and type Error_monad.shell_error = Error_monad.error + + type error += Ecoproto_error of Error_monad.error list + val wrap_error : 'a Error_monad.tzresult -> 'a tzresult + + module Lift (P : Updater.PROTOCOL) : PROTOCOL + + class ['block] proto_rpc_context : + Tezos_rpc.RPC_context.t -> (unit, unit * 'block) RPC_path.t -> + ['block] RPC_context.simple + + class ['block] proto_rpc_context_of_directory : + ('block -> RPC_context.t) -> RPC_context.t RPC_directory.t -> + ['block] RPC_context.simple + + end + + module MakeV1 (Param : sig val name: string end)() + : V1 with type Context.t = Context.t + and type Updater.validation_result = validation_result + and type Updater.quota = quota + and type Updater.rpc_context = rpc_context + +end diff --git a/src/lib_protocol_environment_client/fake_context.ml b/src/lib_protocol_environment/tezos_protocol_environment_faked.ml similarity index 52% rename from src/lib_protocol_environment_client/fake_context.ml rename to src/lib_protocol_environment/tezos_protocol_environment_faked.ml index 1eb372db3..18ed49f63 100644 --- a/src/lib_protocol_environment_client/fake_context.ml +++ b/src/lib_protocol_environment/tezos_protocol_environment_faked.ml @@ -7,16 +7,24 @@ (* *) (**************************************************************************) -type t +module Context = struct + type t -type key = string list -type value = MBytes.t -let mem _ _ = assert false -let dir_mem _ _ = assert false -let get _ _ = assert false -let set _ _ _ = assert false -let del _ _ = assert false -let remove_rec _ _ = assert false -let fold _ _ ~init:_ ~f:_ = assert false -let keys _ _ = assert false -let fold_keys _ _ ~init:_ ~f:_ = assert false + type key = string list + type value = MBytes.t + let mem _ _ = assert false + let dir_mem _ _ = assert false + let get _ _ = assert false + let set _ _ _ = assert false + let del _ _ = assert false + let remove_rec _ _ = assert false + let fold _ _ ~init:_ ~f:_ = assert false + let keys _ _ = assert false + let fold_keys _ _ ~init:_ ~f:_ = assert false + + let set_protocol _ _ = assert false + let fork_test_chain _ ~protocol:_ ~expiration:_ = assert false + +end + +include Tezos_protocol_environment.Make(Context) diff --git a/src/lib_protocol_environment/tezos_protocol_environment_memory.ml b/src/lib_protocol_environment/tezos_protocol_environment_memory.ml new file mode 100644 index 000000000..e5672a3a1 --- /dev/null +++ b/src/lib_protocol_environment/tezos_protocol_environment_memory.ml @@ -0,0 +1,124 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +module Context = struct + + module StringMap = Map.Make(String) + + type key = string list + type value = MBytes.t + + type t = + | Dir of t StringMap.t + | Key of value + + let empty = Dir StringMap.empty + + let rec raw_get m k = + match k, m with + | [], m -> Some m + | n :: k, Dir m -> begin + try raw_get (StringMap.find n m) k + with Not_found -> None + end + | _ :: _, Key _ -> None + + let rec raw_set m k v = + match k, m, v with + | [], (Key _ as m), Some v -> + if m = v then None else Some v + | [], (Dir _ as m), Some v -> + if m == v then None else Some v + | [], (Key _ | Dir _), None -> Some empty + | n :: k, Dir m, _ -> begin + match raw_set (StringMap.find n m) k v with + | exception Not_found -> begin + match raw_set empty k v with + | None -> None + | Some rm -> + if rm = empty then + Some (Dir (StringMap.remove n m)) + else + Some (Dir (StringMap.add n rm m)) + end + | None -> None + | Some rm -> + if rm = empty then + Some (Dir (StringMap.remove n m)) + else + Some (Dir (StringMap.add n rm m)) + end + | _ :: _, Key _, None -> None + | _ :: _, Key _, Some _ -> + Pervasives.failwith "Mem_context.set" + + let mem m k = + match raw_get m k with + | Some (Key _) -> Lwt.return_true + | Some (Dir _) | None -> Lwt.return_false + + let dir_mem m k = + match raw_get m k with + | Some (Dir _) -> Lwt.return_true + | Some (Key _) | None -> Lwt.return_false + + let get m k = + match raw_get m k with + | Some (Key v) -> Lwt.return_some v + | Some (Dir _) | None -> Lwt.return_none + + let set m k v = + match raw_set m k (Some (Key v)) with + | None -> Lwt.return m + | Some m -> Lwt.return m + let del m k = + (* TODO assert key *) + match raw_set m k None with + | None -> Lwt.return m + | Some m -> Lwt.return m + let remove_rec m k = + match raw_set m k None with + | None -> Lwt.return m + | Some m -> Lwt.return m + + let fold m k ~init ~f = + match raw_get m k with + | None -> Lwt.return init + | Some (Key _) -> Lwt.return init + | Some (Dir m) -> + StringMap.fold + (fun n m acc -> + acc >>= fun acc -> + match m with + | Key _ -> f (`Key (k @ [n])) acc + | Dir _ -> f (`Dir (k @ [n])) acc) + m (Lwt.return init) + + let rec pp ppf m = + match m with + | Key s -> Format.fprintf ppf "%s" (MBytes.to_string s) + | Dir m -> + StringMap.iter + (fun n m -> + match m with + | Key s -> + Format.fprintf ppf "- %s: %s@ " n (MBytes.to_string s) + | Dir m -> + Format.fprintf ppf "- %s:@[@ %a@]@ " n pp (Dir m)) + m + + let dump m = Format.eprintf "@[%a@]" pp m + + let set_protocol _ _ = assert false + + let fork_test_chain _ ~protocol:_ ~expiration:_ = assert false + +end + +include Tezos_protocol_environment.Make(Context) diff --git a/src/lib_protocol_environment_client/fake_context.mli b/src/lib_protocol_environment/tezos_protocol_environment_node.ml similarity index 92% rename from src/lib_protocol_environment_client/fake_context.mli rename to src/lib_protocol_environment/tezos_protocol_environment_node.ml index 0268188c8..2f253d933 100644 --- a/src/lib_protocol_environment_client/fake_context.mli +++ b/src/lib_protocol_environment/tezos_protocol_environment_node.ml @@ -7,4 +7,4 @@ (* *) (**************************************************************************) -include Protocol_environment.CONTEXT +include Tezos_protocol_environment.Make(Context) diff --git a/src/lib_protocol_environment_client/mem_context.mli b/src/lib_protocol_environment/tezos_protocol_environment_shell.ml similarity index 84% rename from src/lib_protocol_environment_client/mem_context.mli rename to src/lib_protocol_environment/tezos_protocol_environment_shell.ml index b2708797b..e1dddf119 100644 --- a/src/lib_protocol_environment_client/mem_context.mli +++ b/src/lib_protocol_environment/tezos_protocol_environment_shell.ml @@ -7,9 +7,4 @@ (* *) (**************************************************************************) -include Protocol_environment.CONTEXT - -val empty : t - -val pp : Format.formatter -> t -> unit -val dump : t -> unit +include Tezos_protocol_environment.Make(Tezos_storage.Context) diff --git a/src/lib_protocol_environment_client/fake.ml b/src/lib_protocol_environment_client/fake.ml deleted file mode 100644 index 8f03348a2..000000000 --- a/src/lib_protocol_environment_client/fake.ml +++ /dev/null @@ -1,12 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2018. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -module Make(Param : sig val name: string end)() = - Tezos_base.Protocol_environment.MakeV1 - (Param)(Fake_context)(Fake_updater.Make(Fake_context))() diff --git a/src/lib_protocol_environment_client/fake_updater.ml b/src/lib_protocol_environment_client/fake_updater.ml deleted file mode 100644 index 2788cbf8f..000000000 --- a/src/lib_protocol_environment_client/fake_updater.ml +++ /dev/null @@ -1,78 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2018. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -module Make(Context : Protocol_environment.CONTEXT) = struct - - type validation_result = { - context: Context.t ; - fitness: Fitness.t ; - message: string option ; - max_operation_data_length: int ; - max_operations_ttl: int ; - } - - type quota = { - max_size: int ; - max_op: int option ; - } - - type rpc_context = { - block_hash: Block_hash.t ; - block_header: Block_header.t ; - operation_hashes: unit -> Operation_hash.t list list Lwt.t ; - operations: unit -> Operation.t list list Lwt.t ; - context: Context.t ; - } - - module type RAW_PROTOCOL = sig - type error = .. - type 'a tzresult = ('a, error list) result - val max_block_length: int - val validation_passes: quota list - type operation - val parse_operation: - Operation_hash.t -> Operation.t -> operation tzresult - val acceptable_passes: operation -> int list - val compare_operations: operation -> operation -> int - type validation_state - val current_context: validation_state -> Context.t tzresult Lwt.t - val precheck_block: - ancestor_context: Context.t -> - ancestor_timestamp: Time.t -> - Block_header.t -> - unit tzresult Lwt.t - val begin_application: - predecessor_context: Context.t -> - predecessor_timestamp: Time.t -> - predecessor_fitness: Fitness.t -> - Block_header.t -> - validation_state tzresult Lwt.t - val begin_construction: - predecessor_context: Context.t -> - predecessor_timestamp: Time.t -> - predecessor_level: Int32.t -> - predecessor_fitness: Fitness.t -> - predecessor: Block_hash.t -> - timestamp: Time.t -> - ?protocol_data: MBytes.t -> - unit -> validation_state tzresult Lwt.t - val apply_operation: - validation_state -> operation -> validation_state tzresult Lwt.t - val finalize_block: - validation_state -> validation_result tzresult Lwt.t - val rpc_services: rpc_context Lwt.t RPC_directory.t - val configure_sandbox: - Context.t -> Data_encoding.json option -> Context.t tzresult Lwt.t - end - - let compile _ _ = assert false - let activate _ _ = assert false - let fork_test_chain _ ~protocol:_ ~expiration:_ = assert false - -end diff --git a/src/lib_protocol_environment_client/fake_updater.mli b/src/lib_protocol_environment_client/fake_updater.mli deleted file mode 100644 index d19b42eb6..000000000 --- a/src/lib_protocol_environment_client/fake_updater.mli +++ /dev/null @@ -1,11 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2018. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -module Make(Context : Protocol_environment.CONTEXT) : - Protocol_environment.UPDATER with module Context := Context diff --git a/src/lib_protocol_environment_client/jbuild b/src/lib_protocol_environment_client/jbuild deleted file mode 100644 index 513874e40..000000000 --- a/src/lib_protocol_environment_client/jbuild +++ /dev/null @@ -1,17 +0,0 @@ -(jbuild_version 1) - -(library - ((name tezos_protocol_environment_client) - (public_name tezos-protocol-environment-client) - (libraries (tezos-base - tezos-protocol-environment-sigs - tezos-micheline)) - (flags (:standard -w -9+27-30-32-40@8 - -safe-string - -open Tezos_base__TzPervasives - -open Tezos_micheline)))) - -(alias - ((name runtest_indent) - (deps ((glob_files *.ml*))) - (action (run bash ${libexec:tezos-stdlib:test-ocp-indent.sh} ${^})))) diff --git a/src/lib_protocol_environment_client/mem.ml b/src/lib_protocol_environment_client/mem.ml deleted file mode 100644 index 5680678a0..000000000 --- a/src/lib_protocol_environment_client/mem.ml +++ /dev/null @@ -1,12 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2018. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -module Make(Param : sig val name: string end)() = - Tezos_base.Protocol_environment.MakeV1 - (Param)(Mem_context)(Fake_updater.Make(Mem_context))() diff --git a/src/lib_protocol_environment_client/mem_context.ml b/src/lib_protocol_environment_client/mem_context.ml deleted file mode 100644 index 9aa14a8de..000000000 --- a/src/lib_protocol_environment_client/mem_context.ml +++ /dev/null @@ -1,114 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2018. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -module StringMap = Map.Make(String) - -type key = string list -type value = MBytes.t - -type t = - | Dir of t StringMap.t - | Key of value - -let empty = Dir StringMap.empty - -let rec raw_get m k = - match k, m with - | [], m -> Some m - | n :: k, Dir m -> begin - try raw_get (StringMap.find n m) k - with Not_found -> None - end - | _ :: _, Key _ -> None - -let rec raw_set m k v = - match k, m, v with - | [], (Key _ as m), Some v -> - if m = v then None else Some v - | [], (Dir _ as m), Some v -> - if m == v then None else Some v - | [], (Key _ | Dir _), None -> Some empty - | n :: k, Dir m, _ -> begin - match raw_set (StringMap.find n m) k v with - | exception Not_found -> begin - match raw_set empty k v with - | None -> None - | Some rm -> - if rm = empty then - Some (Dir (StringMap.remove n m)) - else - Some (Dir (StringMap.add n rm m)) - end - | None -> None - | Some rm -> - if rm = empty then - Some (Dir (StringMap.remove n m)) - else - Some (Dir (StringMap.add n rm m)) - end - | _ :: _, Key _, None -> None - | _ :: _, Key _, Some _ -> - Pervasives.failwith "Mem_context.set" - -let mem m k = - match raw_get m k with - | Some (Key _) -> Lwt.return_true - | Some (Dir _) | None -> Lwt.return_false - -let dir_mem m k = - match raw_get m k with - | Some (Dir _) -> Lwt.return_true - | Some (Key _) | None -> Lwt.return_false - -let get m k = - match raw_get m k with - | Some (Key v) -> Lwt.return_some v - | Some (Dir _) | None -> Lwt.return_none - -let set m k v = - match raw_set m k (Some (Key v)) with - | None -> Lwt.return m - | Some m -> Lwt.return m -let del m k = - (* TODO assert key *) - match raw_set m k None with - | None -> Lwt.return m - | Some m -> Lwt.return m -let remove_rec m k = - match raw_set m k None with - | None -> Lwt.return m - | Some m -> Lwt.return m - -let fold m k ~init ~f = - match raw_get m k with - | None -> Lwt.return init - | Some (Key _) -> Lwt.return init - | Some (Dir m) -> - StringMap.fold - (fun n m acc -> - acc >>= fun acc -> - match m with - | Key _ -> f (`Key (k @ [n])) acc - | Dir _ -> f (`Dir (k @ [n])) acc) - m (Lwt.return init) - -let rec pp ppf m = - match m with - | Key s -> Format.fprintf ppf "%s" (MBytes.to_string s) - | Dir m -> - StringMap.iter - (fun n m -> - match m with - | Key s -> - Format.fprintf ppf "- %s: %s@ " n (MBytes.to_string s) - | Dir m -> - Format.fprintf ppf "- %s:@[@ %a@]@ " n pp (Dir m)) - m - -let dump m = Format.eprintf "@[%a@]" pp m diff --git a/src/lib_protocol_updater/jbuild b/src/lib_protocol_updater/jbuild index d3e05019b..94d131d72 100644 --- a/src/lib_protocol_updater/jbuild +++ b/src/lib_protocol_updater/jbuild @@ -6,6 +6,7 @@ (libraries (tezos-base tezos-stdlib-unix tezos-micheline + tezos-protocol-environment-shell tezos-protocol-compiler.registerer tezos-protocol-compiler.native tezos-storage diff --git a/src/lib_protocol_updater/registred_protocol.ml b/src/lib_protocol_updater/registred_protocol.ml index c1c2882c4..d4a3f7767 100644 --- a/src/lib_protocol_updater/registred_protocol.ml +++ b/src/lib_protocol_updater/registred_protocol.ml @@ -9,7 +9,7 @@ module type T = sig val hash: Protocol_hash.t - include Updater.NODE_PROTOCOL + include Tezos_protocol_environment_shell.PROTOCOL val complete_b58prefix : Context.t -> string -> string list Lwt.t end @@ -20,7 +20,7 @@ let build_v1 hash = let module Name = struct let name = Protocol_hash.to_b58check hash end in - let module Env = Protocol_environment.MakeV1(Name)(Context)(Updater)() in + let module Env = Tezos_protocol_environment_shell.MakeV1(Name)() in (module struct let hash = hash module P = F(Env) @@ -49,7 +49,7 @@ let get hash = with Not_found -> None module Register - (Env : Updater.Node_protocol_environment_sigs.V1) + (Env : Tezos_protocol_environment_shell.V1) (Proto : Env.Updater.PROTOCOL) (Source : sig val hash: Protocol_hash.t option diff --git a/src/lib_protocol_updater/registred_protocol.mli b/src/lib_protocol_updater/registred_protocol.mli index 8ac17eae4..82f51984f 100644 --- a/src/lib_protocol_updater/registred_protocol.mli +++ b/src/lib_protocol_updater/registred_protocol.mli @@ -9,7 +9,7 @@ module type T = sig val hash: Protocol_hash.t - include Updater.NODE_PROTOCOL + include Tezos_protocol_environment_shell.PROTOCOL val complete_b58prefix : Context.t -> string -> string list Lwt.t end @@ -22,7 +22,7 @@ val get_exn: Protocol_hash.t -> t module Register - (Env : Updater.Node_protocol_environment_sigs.V1) + (Env : Tezos_protocol_environment_shell.V1) (Proto : Env.Updater.PROTOCOL) (Source : sig val hash: Protocol_hash.t option diff --git a/src/lib_protocol_updater/tezos-protocol-updater.opam b/src/lib_protocol_updater/tezos-protocol-updater.opam index 39f799e2d..871d47797 100644 --- a/src/lib_protocol_updater/tezos-protocol-updater.opam +++ b/src/lib_protocol_updater/tezos-protocol-updater.opam @@ -12,6 +12,7 @@ depends: [ "tezos-base" "tezos-micheline" "tezos-protocol-compiler" + "tezos-protocol-environment-shell" "tezos-stdlib-unix" "tezos-storage" ] diff --git a/src/lib_protocol_updater/updater.ml b/src/lib_protocol_updater/updater.ml index c3beaeeca..1195fb503 100644 --- a/src/lib_protocol_updater/updater.ml +++ b/src/lib_protocol_updater/updater.ml @@ -11,114 +11,62 @@ open Logging.Updater let (//) = Filename.concat -module Raw = struct +(** Compiler *) - type validation_result = { - context: Context.t ; - fitness: Fitness.t ; - message: string option ; - max_operation_data_length: int ; - max_operations_ttl: int ; - } +let datadir = ref None +let get_datadir () = + match !datadir with + | None -> + fatal_error "Node not initialized" ; + Lwt_exit.exit 1 + | Some m -> m - type quota = { - max_size: int ; - max_op: int option ; - } +let init dir = + datadir := Some dir - type rpc_context = { - block_hash: Block_hash.t ; - block_header: Block_header.t ; - operation_hashes: unit -> Operation_hash.t list list Lwt.t ; - operations: unit -> Operation.t list list Lwt.t ; - context: Context.t ; - } +let compiler_name = "tezos-protocol-compiler" - let activate = Context.set_protocol - let fork_test_chain = Context.fork_test_chain - - (** Compiler *) - - let datadir = ref None - let get_datadir () = - match !datadir with - | None -> - fatal_error "Node not initialized" ; - Lwt_exit.exit 1 - | Some m -> m - - let init dir = - datadir := Some dir - - let compiler_name = "tezos-protocol-compiler" - - let do_compile hash p = - assert (p.Protocol.expected_env = V1) ; - let datadir = get_datadir () in - let source_dir = datadir // Protocol_hash.to_short_b58check hash // "src" in - let log_file = datadir // Protocol_hash.to_short_b58check hash // "LOG" in - let plugin_file = datadir // Protocol_hash.to_short_b58check hash // - Format.asprintf "protocol_%a" Protocol_hash.pp hash - in - begin - Lwt_utils_unix.Protocol.write_dir source_dir ~hash p >>=? fun () -> - let compiler_command = - (Sys.executable_name, - Array.of_list [compiler_name; "-register"; plugin_file; source_dir]) in - let fd = Unix.(openfile log_file [O_WRONLY; O_CREAT; O_TRUNC] 0o644) in - Lwt_process.exec - ~stdin:`Close ~stdout:(`FD_copy fd) ~stderr:(`FD_move fd) - compiler_command >>= return - end >>= function - | Error err -> - log_error "Error %a" pp_print_error err ; +let do_compile hash p = + assert (p.Protocol.expected_env = V1) ; + let datadir = get_datadir () in + let source_dir = datadir // Protocol_hash.to_short_b58check hash // "src" in + let log_file = datadir // Protocol_hash.to_short_b58check hash // "LOG" in + let plugin_file = datadir // Protocol_hash.to_short_b58check hash // + Format.asprintf "protocol_%a" Protocol_hash.pp hash + in + begin + Lwt_utils_unix.Protocol.write_dir source_dir ~hash p >>=? fun () -> + let compiler_command = + (Sys.executable_name, + Array.of_list [compiler_name; "-register"; plugin_file; source_dir]) in + let fd = Unix.(openfile log_file [O_WRONLY; O_CREAT; O_TRUNC] 0o644) in + Lwt_process.exec + ~stdin:`Close ~stdout:(`FD_copy fd) ~stderr:(`FD_move fd) + compiler_command >>= return + end >>= function + | Error err -> + log_error "Error %a" pp_print_error err ; + Lwt.return false + | Ok (Unix.WSIGNALED _ | Unix.WSTOPPED _) -> + log_error "INTERRUPTED COMPILATION (%s)" log_file; + Lwt.return false + | Ok (Unix.WEXITED x) when x <> 0 -> + log_error "COMPILATION ERROR (%s)" log_file; + Lwt.return false + | Ok (Unix.WEXITED _) -> + try Dynlink.loadfile_private (plugin_file ^ ".cmxs"); Lwt.return true + with Dynlink.Error err -> + log_error "Can't load plugin: %s (%s)" + (Dynlink.error_message err) plugin_file; Lwt.return false - | Ok (Unix.WSIGNALED _ | Unix.WSTOPPED _) -> - log_error "INTERRUPTED COMPILATION (%s)" log_file; - Lwt.return false - | Ok (Unix.WEXITED x) when x <> 0 -> - log_error "COMPILATION ERROR (%s)" log_file; - Lwt.return false - | Ok (Unix.WEXITED _) -> - try Dynlink.loadfile_private (plugin_file ^ ".cmxs"); Lwt.return true - with Dynlink.Error err -> - log_error "Can't load plugin: %s (%s)" - (Dynlink.error_message err) plugin_file; - Lwt.return false - - let compile hash p = - if Tezos_protocol_registerer.Registerer.mem hash then - Lwt.return true - else begin - do_compile hash p >>= fun success -> - let loaded = Tezos_protocol_registerer.Registerer.mem hash in - if success && not loaded then - log_error "Internal error while compiling %a" Protocol_hash.pp hash; - Lwt.return loaded - end - -end - -include Raw - -module type NODE_PROTOCOL = Protocol_environment.T - with type context := Context.t - and type validation_result := validation_result - and type quota := quota - and type rpc_context := rpc_context - and type 'a tzresult := 'a tzresult - -module Node_protocol_environment_sigs = struct - - module type V1 = Protocol_environment.V1 - with type Context.t = Context.t - and type Updater.validation_result = validation_result - and type Updater.quota = quota - and type Updater.rpc_context = rpc_context - -end - -module MakeV1(Name : sig val name: string end)() - : Node_protocol_environment_sigs.V1 = - Protocol_environment.MakeV1(Name)(Context)(Raw)() +let compile hash p = + if Tezos_protocol_registerer.Registerer.mem hash then + Lwt.return true + else begin + do_compile hash p >>= fun success -> + let loaded = Tezos_protocol_registerer.Registerer.mem hash in + if success && not loaded then + log_error "Internal error while compiling %a" Protocol_hash.pp hash; + Lwt.return loaded + end diff --git a/src/lib_protocol_updater/updater.mli b/src/lib_protocol_updater/updater.mli index a7b85b5ec..d94d968b9 100644 --- a/src/lib_protocol_updater/updater.mli +++ b/src/lib_protocol_updater/updater.mli @@ -7,60 +7,8 @@ (* *) (**************************************************************************) -(* See `src/environment/v1/updater.mli` for documentation. *) - val compile: Protocol_hash.t -> Protocol.t -> bool Lwt.t -val activate: Context.t -> Protocol_hash.t -> Context.t Lwt.t -val fork_test_chain: - Context.t -> protocol:Protocol_hash.t -> expiration:Time.t -> Context.t Lwt.t val init: string -> unit -type validation_result = { - context: Context.t ; - fitness: Fitness.t ; - message: string option ; - max_operation_data_length: int ; - max_operations_ttl: int ; -} - -type quota = { - max_size: int ; - max_op: int option ; -} - -type rpc_context = { - block_hash: Block_hash.t ; - block_header: Block_header.t ; - operation_hashes: unit -> Operation_hash.t list list Lwt.t ; - operations: unit -> Operation.t list list Lwt.t ; - context: Context.t ; -} - -(* The end of this file is not exported to the protocol... *) - val compiler_name: string - -module type NODE_PROTOCOL = Protocol_environment.T - with type context := Context.t - and type validation_result := validation_result - and type quota := quota - and type rpc_context := rpc_context - and type 'a tzresult := 'a tzresult - -module Node_protocol_environment_sigs : sig - - module type V1 = sig - - include Protocol_environment.V1 - with type Context.t = Context.t - and type Updater.validation_result = validation_result - and type Updater.quota = quota - and type Updater.rpc_context = rpc_context - - end - -end - -module MakeV1(Name : sig val name: string end)() : - Node_protocol_environment_sigs.V1 diff --git a/src/lib_shell/block_validator.ml b/src/lib_shell/block_validator.ml index 696f6ff77..70334fd55 100644 --- a/src/lib_shell/block_validator.ml +++ b/src/lib_shell/block_validator.ml @@ -124,8 +124,8 @@ let apply_block (fun i ops quota -> fail_unless (Option.unopt_map ~default:true - ~f:(fun max -> List.length ops <= max) quota.Updater.max_op) - (let max = Option.unopt ~default:~-1 quota.Updater.max_op in + ~f:(fun max -> List.length ops <= max) quota.Tezos_protocol_environment_shell.max_op) + (let max = Option.unopt ~default:~-1 quota.max_op in invalid_block hash @@ Too_many_operations { pass = i + 1 ; found = List.length ops ; max }) >>=? fun () -> diff --git a/src/lib_shell/distributed_db.mli b/src/lib_shell/distributed_db.mli index 44dfaf1e9..904a93b51 100644 --- a/src/lib_shell/distributed_db.mli +++ b/src/lib_shell/distributed_db.mli @@ -125,7 +125,7 @@ val commit_block: chain_db -> Block_hash.t -> Block_header.t -> Operation.t list list -> - Updater.validation_result -> + Tezos_protocol_environment_shell.validation_result -> State.Block.t option tzresult Lwt.t (** Store on disk all the data associated to an invalid block. *) diff --git a/src/lib_shell/node.ml b/src/lib_shell/node.ml index 44a8c786d..42578478a 100644 --- a/src/lib_shell/node.ml +++ b/src/lib_shell/node.ml @@ -310,11 +310,11 @@ module RPC = struct test_chain ; } - let rpc_context block : Updater.rpc_context Lwt.t = + let rpc_context block : Tezos_protocol_environment_shell.rpc_context Lwt.t = let block_hash = State.Block.hash block in let block_header = State.Block.header block in State.Block.context block >|= fun context -> - { Updater.block_hash ; + { Tezos_protocol_environment_shell.block_hash ; block_header ; operation_hashes = (fun () -> State.Block.all_operation_hashes block) ; operations = (fun () -> State.Block.all_operations block) ; @@ -370,7 +370,8 @@ module RPC = struct Operation_list_list_hash.compute (List.map Operation_list_hash.compute operation_hashes) in Lwt.return (Some { - Updater.block_hash = prevalidation_hash ; + Tezos_protocol_environment_shell. + block_hash = prevalidation_hash ; block_header = { shell = { level = Int32.succ head_header.shell.level ; diff --git a/src/lib_shell/prevalidation.mli b/src/lib_shell/prevalidation.mli index 8cccb6326..13be9e85e 100644 --- a/src/lib_shell/prevalidation.mli +++ b/src/lib_shell/prevalidation.mli @@ -21,4 +21,5 @@ val prevalidate : (prevalidation_state * error Preapply_result.t) Lwt.t val end_prevalidation : - prevalidation_state -> Updater.validation_result tzresult Lwt.t + prevalidation_state -> + Tezos_protocol_environment_shell.validation_result tzresult Lwt.t diff --git a/src/lib_shell/prevalidator.mli b/src/lib_shell/prevalidator.mli index 4a4f141ed..5c659bcc3 100644 --- a/src/lib_shell/prevalidator.mli +++ b/src/lib_shell/prevalidator.mli @@ -45,7 +45,7 @@ val inject_operation: t -> Operation.t -> unit tzresult Lwt.t val flush: t -> Block_hash.t -> unit tzresult Lwt.t val timestamp: t -> Time.t val operations: t -> error Preapply_result.t * Operation.t Operation_hash.Map.t -val context: t -> Updater.validation_result tzresult Lwt.t +val context: t -> Tezos_protocol_environment_shell.validation_result tzresult Lwt.t val pending: ?block:State.Block.t -> t -> Operation.t Operation_hash.Map.t Lwt.t val running_workers: unit -> (Chain_id.t * t) list diff --git a/src/lib_shell/state.ml b/src/lib_shell/state.ml index 6a484c0af..e2db5bcdb 100644 --- a/src/lib_shell/state.ml +++ b/src/lib_shell/state.ml @@ -570,8 +570,8 @@ module Block = struct let store ?(dont_enforce_context_hash = false) chain_state block_header operations - { Updater.context ; message ; max_operations_ttl ; - max_operation_data_length } = + { Tezos_protocol_environment_shell.context ; message ; + max_operations_ttl ; max_operation_data_length } = let bytes = Block_header.to_bytes block_header in let hash = Block_header.hash_raw bytes in (* let's the validator check the consistency... of fitness, level, ... *) diff --git a/src/lib_shell/state.mli b/src/lib_shell/state.mli index 47a6c1be8..8a50e7685 100644 --- a/src/lib_shell/state.mli +++ b/src/lib_shell/state.mli @@ -112,7 +112,7 @@ module Block : sig Chain.t -> Block_header.t -> Operation.t list list -> - Updater.validation_result -> + Tezos_protocol_environment_shell.validation_result -> block option tzresult Lwt.t val store_invalid: diff --git a/src/lib_shell/test/test_locator.ml b/src/lib_shell/test/test_locator.ml index aabbd0450..4a99c5d5d 100644 --- a/src/lib_shell/test/test_locator.ml +++ b/src/lib_shell/test/test_locator.ml @@ -89,7 +89,7 @@ let make_empty_chain (chain:State.Chain.t) n : Block_hash.t Lwt.t = Context.commit ~time:header.shell.timestamp empty_context >>= fun context -> let header = { header with shell = { header.shell with context } } in - let empty_result : Updater.validation_result = { + let empty_result : Tezos_protocol_environment_shell.validation_result = { context = empty_context ; fitness = [] ; message = None ; diff --git a/src/proto_alpha/lib_baking/jbuild b/src/proto_alpha/lib_baking/jbuild index 126c1c912..3cc1f957d 100644 --- a/src/proto_alpha/lib_baking/jbuild +++ b/src/proto_alpha/lib_baking/jbuild @@ -5,7 +5,7 @@ (public_name tezos-baking-alpha) (libraries (tezos-base tezos-protocol-alpha - tezos-protocol-environment-client + tezos-protocol-environment tezos-shell-services tezos-client-base tezos-client-alpha @@ -27,7 +27,7 @@ (public_name tezos-baking-alpha-commands) (libraries (tezos-base tezos-protocol-alpha - tezos-protocol-environment-client + tezos-protocol-environment tezos-shell-services tezos-client-base tezos-client-alpha @@ -50,7 +50,7 @@ (public_name tezos-baking-alpha-commands.registration) (libraries (tezos-base tezos-protocol-alpha - tezos-protocol-environment-client + tezos-protocol-environment tezos-shell-services tezos-client-base tezos-client-alpha diff --git a/src/proto_alpha/lib_baking/tezos-baking-alpha-commands.opam b/src/proto_alpha/lib_baking/tezos-baking-alpha-commands.opam index 5ee36d991..fb976fb67 100644 --- a/src/proto_alpha/lib_baking/tezos-baking-alpha-commands.opam +++ b/src/proto_alpha/lib_baking/tezos-baking-alpha-commands.opam @@ -10,7 +10,7 @@ depends: [ "ocamlfind" { build } "jbuilder" { build & >= "1.0+beta17" } "tezos-base" - "tezos-protocol-environment-client" + "tezos-protocol-environment" "tezos-protocol-alpha" "tezos-shell-services" "tezos-client-base" diff --git a/src/proto_alpha/lib_baking/tezos-baking-alpha.opam b/src/proto_alpha/lib_baking/tezos-baking-alpha.opam index f77ebc095..8329db119 100644 --- a/src/proto_alpha/lib_baking/tezos-baking-alpha.opam +++ b/src/proto_alpha/lib_baking/tezos-baking-alpha.opam @@ -10,7 +10,7 @@ depends: [ "ocamlfind" { build } "jbuilder" { build & >= "1.0+beta17" } "tezos-base" - "tezos-protocol-environment-client" + "tezos-protocol-environment" "tezos-protocol-alpha" "tezos-shell-services" "tezos-client-base" diff --git a/src/proto_alpha/lib_client/jbuild b/src/proto_alpha/lib_client/jbuild index cc6a4157e..478071476 100644 --- a/src/proto_alpha/lib_client/jbuild +++ b/src/proto_alpha/lib_client/jbuild @@ -5,7 +5,7 @@ (public_name tezos-client-alpha) (libraries (tezos-base tezos-protocol-alpha - tezos-protocol-environment-client + tezos-protocol-environment tezos-shell-services tezos-client-base tezos-rpc)) diff --git a/src/proto_alpha/lib_client/proto_alpha.ml b/src/proto_alpha/lib_client/proto_alpha.ml index d0d4aab02..0aa7b6686 100644 --- a/src/proto_alpha/lib_client/proto_alpha.ml +++ b/src/proto_alpha/lib_client/proto_alpha.ml @@ -8,7 +8,7 @@ (**************************************************************************) module Name = struct let name = "alpha" end -module Alpha_environment = Tezos_protocol_environment_client.Fake.Make(Name)() +module Alpha_environment = Tezos_protocol_environment_faked.MakeV1(Name)() include Tezos_protocol_alpha.Functor.Make(Alpha_environment) let hash = diff --git a/src/proto_alpha/lib_client/tezos-client-alpha.opam b/src/proto_alpha/lib_client/tezos-client-alpha.opam index c3388e00f..ed4091a8d 100644 --- a/src/proto_alpha/lib_client/tezos-client-alpha.opam +++ b/src/proto_alpha/lib_client/tezos-client-alpha.opam @@ -10,7 +10,7 @@ depends: [ "ocamlfind" { build } "jbuilder" { build & >= "1.0+beta17" } "tezos-base" - "tezos-protocol-environment-client" + "tezos-protocol-environment" "tezos-protocol-alpha" "tezos-shell-services" "tezos-client-base" diff --git a/src/proto_alpha/lib_client_commands/jbuild b/src/proto_alpha/lib_client_commands/jbuild index 4ae05f3e2..385e5f7ee 100644 --- a/src/proto_alpha/lib_client_commands/jbuild +++ b/src/proto_alpha/lib_client_commands/jbuild @@ -5,7 +5,7 @@ (public_name tezos-client-alpha-commands) (libraries (tezos-base tezos-protocol-alpha - tezos-protocol-environment-client + tezos-protocol-environment tezos-shell-services tezos-client-base tezos-client-alpha @@ -27,7 +27,7 @@ (public_name tezos-client-alpha-commands.registration) (libraries (tezos-base tezos-protocol-alpha - tezos-protocol-environment-client + tezos-protocol-environment tezos-shell-services tezos-client-base tezos-client-alpha diff --git a/src/proto_alpha/lib_client_commands/tezos-client-alpha-commands.opam b/src/proto_alpha/lib_client_commands/tezos-client-alpha-commands.opam index e95d62693..b77d256e2 100644 --- a/src/proto_alpha/lib_client_commands/tezos-client-alpha-commands.opam +++ b/src/proto_alpha/lib_client_commands/tezos-client-alpha-commands.opam @@ -10,7 +10,7 @@ depends: [ "ocamlfind" { build } "jbuilder" { build & >= "1.0+beta17" } "tezos-base" - "tezos-protocol-environment-client" + "tezos-protocol-environment" "tezos-protocol-alpha" "tezos-shell-services" "tezos-client-base" diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_block.ml b/src/proto_alpha/lib_protocol/test/helpers/helpers_block.ml index 04071470d..f8431610a 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_block.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/helpers_block.ml @@ -25,14 +25,14 @@ type init_block = { protocol_data_bytes : MBytes.t ; timestamp : Time.t ; level : Int32.t ; - context : Context.t + context : Tezos_protocol_environment_memory.Context.t } type result = { tezos_header : tezos_header ; hash : Block_hash.t ; level : Int32.t ; - validation : Updater.validation_result ; + validation : Tezos_protocol_environment_memory.validation_result ; tezos_context : Proto_alpha.Alpha_context.t } @@ -107,7 +107,7 @@ let get_level opt_msg = let get_header_hash (init_block : init_block) - (validation_result : Updater.validation_result) + (validation_result : Tezos_protocol_environment_memory.validation_result) : result tzresult Lwt.t = let op_hashs = init_block.operation_hashs in diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_block.mli b/src/proto_alpha/lib_protocol/test/helpers/helpers_block.mli index c4a7c4b98..914ecbfa9 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_block.mli +++ b/src/proto_alpha/lib_protocol/test/helpers/helpers_block.mli @@ -28,7 +28,7 @@ type init_block = { protocol_data_bytes : MBytes.t; timestamp : Time.t; level : Int32.t; - context : Context.t; + context : Tezos_protocol_environment_memory.Context.t } (** Result of the application of a block *) @@ -36,7 +36,7 @@ type result = { tezos_header : tezos_header; hash : Block_hash.t; level : Int32.t; - validation : Updater.validation_result; + validation : Tezos_protocol_environment_memory.validation_result; tezos_context : Alpha_context.t; } val get_op_header_res : result -> operation_header @@ -57,7 +57,7 @@ val init_of_result : init_block proto_tzresult val get_level : string option -> int32 val get_header_hash : - init_block -> Updater.validation_result -> + init_block -> Tezos_protocol_environment_memory.validation_result -> result proto_tzresult Lwt.t val begin_construction_pre : init_block -> Main.validation_state proto_tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_cast.mli b/src/proto_alpha/lib_protocol/test/helpers/helpers_cast.mli index fa7e308a7..429bd3a9b 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_cast.mli +++ b/src/proto_alpha/lib_protocol/test/helpers/helpers_cast.mli @@ -23,5 +23,5 @@ val tez_add_int : Tez.tez -> int -> Tez.tez (** Tez.(-?) with a top - level error instead *) val tez_sub : Tez.tez -> Tez.tez -> Tez.tez val tez_sub_int : Tez.tez -> int -> Tez.tez -val ctxt_of_tc : context -> Mem_context.t +val ctxt_of_tc : context -> Tezos_protocol_environment_memory.Context.t diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_init.ml b/src/proto_alpha/lib_protocol/test/helpers/helpers_init.ml index 63883c227..dfdfa7224 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/helpers_init.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/helpers_init.ml @@ -19,7 +19,7 @@ let get_sandbox () = Lwt.return @@ Helpers_assert.no_error ~msg:__LOC__ x let main () = - let context = Tezos_protocol_environment_client.Mem_context.empty in + let context = Tezos_protocol_environment_memory.Context.empty in get_sandbox () >>= fun json -> Main.configure_sandbox context @@ Some json >>=? fun context -> let genesis_hash = diff --git a/src/proto_alpha/lib_protocol/test/helpers/jbuild b/src/proto_alpha/lib_protocol/test/helpers/jbuild index 53f62fbe0..80d2734c0 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/jbuild +++ b/src/proto_alpha/lib_protocol/test/helpers/jbuild @@ -4,14 +4,13 @@ ((name tezos_proto_alpha_isolate_helpers) (libraries (tezos-base tezos-stdlib-unix - tezos-protocol-environment-client + tezos-protocol-environment tezos-protocol-alpha alcotest-lwt)) (wrapped false) (flags (:standard -w -9-32 -safe-string -open Tezos_base__TzPervasives - -open Tezos_stdlib_unix - -open Tezos_protocol_environment_client)))) + -open Tezos_stdlib_unix)))) (alias ((name runtest_indent) diff --git a/src/proto_alpha/lib_protocol/test/helpers/proto_alpha.ml b/src/proto_alpha/lib_protocol/test/helpers/proto_alpha.ml index ab01b262b..6cf2d00f6 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/proto_alpha.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/proto_alpha.ml @@ -8,12 +8,8 @@ (**************************************************************************) module Name = struct let name = "alpha" end -module Context = - Tezos_protocol_environment_client.Mem_context -module Updater = - Tezos_protocol_environment_client.Fake_updater.Make(Context) -module Alpha_environment = - Tezos_base.Protocol_environment.MakeV1(Name)(Context)(Updater)() +module Context = Tezos_protocol_environment_memory.Context +module Alpha_environment = Tezos_protocol_environment_memory.MakeV1(Name)() include Tezos_protocol_alpha.Functor.Make(Alpha_environment) module Error_monad = Alpha_environment.Error_monad diff --git a/src/proto_alpha/lib_protocol/tezos-protocol-alpha.opam b/src/proto_alpha/lib_protocol/tezos-protocol-alpha.opam index 34a9f532f..11cfcbde8 100644 --- a/src/proto_alpha/lib_protocol/tezos-protocol-alpha.opam +++ b/src/proto_alpha/lib_protocol/tezos-protocol-alpha.opam @@ -12,7 +12,7 @@ depends: [ "tezos-base" "tezos-protocol-compiler" "alcotest-lwt" { test } - "tezos-protocol-environment-client" { test } + "tezos-protocol-environment" { test } ] build: [ [ "rm" "jbuild" "src/jbuild" ] diff --git a/src/proto_genesis/lib_client/jbuild b/src/proto_genesis/lib_client/jbuild index eccd02624..e2444d902 100644 --- a/src/proto_genesis/lib_client/jbuild +++ b/src/proto_genesis/lib_client/jbuild @@ -7,7 +7,7 @@ tezos-shell-services tezos-client-base tezos-client-commands - tezos-protocol-environment-client + tezos-protocol-environment tezos-protocol-genesis tezos-protocol-alpha)) (library_flags (:standard -linkall)) diff --git a/src/proto_genesis/lib_client/proto_alpha.ml b/src/proto_genesis/lib_client/proto_alpha.ml index 93b8f262c..9a646c35b 100644 --- a/src/proto_genesis/lib_client/proto_alpha.ml +++ b/src/proto_genesis/lib_client/proto_alpha.ml @@ -8,5 +8,5 @@ (**************************************************************************) module Name = struct let name = "genesis-alpha" end -module Alpha_environment = Tezos_protocol_environment_client.Fake.Make(Name)() +module Alpha_environment = Tezos_protocol_environment_faked.MakeV1(Name)() include Tezos_protocol_alpha.Functor.Make(Alpha_environment) diff --git a/src/proto_genesis/lib_client/proto_genesis.ml b/src/proto_genesis/lib_client/proto_genesis.ml index 5f66b334f..cf45e0674 100644 --- a/src/proto_genesis/lib_client/proto_genesis.ml +++ b/src/proto_genesis/lib_client/proto_genesis.ml @@ -8,5 +8,5 @@ (**************************************************************************) module Name = struct let name = "genesis" end -module Genesis_environment = Tezos_protocol_environment_client.Fake.Make(Name)() +module Genesis_environment = Tezos_protocol_environment_faked.MakeV1(Name)() include Tezos_protocol_genesis.Functor.Make(Genesis_environment) diff --git a/src/proto_genesis/lib_client/tezos-client-genesis.opam b/src/proto_genesis/lib_client/tezos-client-genesis.opam index b7b12e77e..550afa1f6 100644 --- a/src/proto_genesis/lib_client/tezos-client-genesis.opam +++ b/src/proto_genesis/lib_client/tezos-client-genesis.opam @@ -13,7 +13,7 @@ depends: [ "tezos-shell-services" "tezos-client-base" "tezos-client-commands" - "tezos-protocol-environment-client" + "tezos-protocol-environment" "tezos-protocol-genesis" "tezos-protocol-alpha" ]