balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge `tezos-protocol-environment-{sigs,client}

Browse Source
This commit is contained in:
Grégoire Henry 2018-02-17 14:39:45 +01:00 committed by Benjamin Canou
parent 0e79a65158
commit 697b291782
112 changed files with 1075 additions and 1239 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
.gitlab-ci.yml
View File

@ -326,10 +326,10 @@ opam:22:tezos-protocol-alpha:
variables: variables:
package: tezos-protocol-alpha package: tezos-protocol-alpha
opam:23:tezos-protocol-environment-client: opam:23:tezos-protocol-environment:
<<: *opam_definition <<: *opam_definition
variables: variables:
package: tezos-protocol-environment-client package: tezos-protocol-environment
opam:24:tezos-client-alpha: opam:24:tezos-client-alpha:
<<: *opam_definition <<: *opam_definition
@ -436,6 +436,11 @@ opam:44:tezos-protocol-demo:
variables: variables:
package: tezos-protocol-demo package: tezos-protocol-demo
opam:45:tezos-protocol-environment-shell:
<<: *opam_definition
variables:
package: tezos-protocol-environment-shell
##END_OPAM## ##END_OPAM##

1
src/lib_base/jbuild
View File

@ -17,7 +17,6 @@
tezos-error-monad tezos-error-monad
tezos-rpc tezos-rpc
tezos-micheline tezos-micheline
tezos-protocol-environment-sigs
re.str re.str
calendar calendar
ezjsonm ezjsonm

548
src/lib_base/protocol_environment.ml
View File

@ -1,548 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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
"@[<v 2>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

157
src/lib_base/protocol_environment.mli
View File

@ -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

1
src/lib_base/tezos-base.opam
View File

@ -15,7 +15,6 @@ depends: [
"tezos-error-monad" "tezos-error-monad"
"tezos-micheline" "tezos-micheline"
"tezos-rpc" "tezos-rpc"
"tezos-protocol-environment-sigs"
"calendar" "calendar"
"ezjsonm" { >= "0.5.0" } "ezjsonm" { >= "0.5.0" }
"ipaddr" "ipaddr"

2
src/lib_base/tzPervasives.ml
View File

@ -55,8 +55,6 @@ module P2p_connection = P2p_connection
module P2p_stat = P2p_stat module P2p_stat = P2p_stat
module P2p_version = P2p_version module P2p_version = P2p_version
module Protocol_environment = Protocol_environment
module Cli_entries = Cli_entries module Cli_entries = Cli_entries
module Lwt_exit = Lwt_exit module Lwt_exit = Lwt_exit

2
src/lib_base/tzPervasives.mli
View File

@ -52,8 +52,6 @@ module P2p_connection = P2p_connection
module P2p_stat = P2p_stat module P2p_stat = P2p_stat
module P2p_version = P2p_version module P2p_version = P2p_version
module Protocol_environment = Protocol_environment
module Cli_entries = Cli_entries module Cli_entries = Cli_entries
module Lwt_exit = Lwt_exit module Lwt_exit = Lwt_exit

8
src/lib_protocol_compiler/jbuild_embedded_protocol_template
View File

@ -22,7 +22,7 @@ let () = Format.kasprintf Jbuild_plugin.V1.send {|
((targets (environment.ml)) ((targets (environment.ml))
(action (action
(write-file ${@@} (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 (rule
((targets (registerer.ml)) ((targets (registerer.ml))
@ -35,7 +35,7 @@ let () = Format.kasprintf Jbuild_plugin.V1.send {|
((name tezos_embedded_protocol_environment_%s) ((name tezos_embedded_protocol_environment_%s)
(public_name tezos-embedded-protocol-%s.environment) (public_name tezos-embedded-protocol-%s.environment)
(library_flags (:standard -linkall)) (library_flags (:standard -linkall))
(libraries (tezos-protocol-updater)) (libraries (tezos-protocol-environment-shell))
(modules (Environment)))) (modules (Environment))))
(library (library
@ -55,7 +55,9 @@ let () = Format.kasprintf Jbuild_plugin.V1.send {|
((name tezos_embedded_protocol_%s) ((name tezos_embedded_protocol_%s)
(public_name tezos-embedded-protocol-%s) (public_name tezos-embedded-protocol-%s)
(library_flags (:standard -linkall)) (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)))) (modules (Registerer))))
|} |}
version version version version version version version version version version version version version version version version

31
src/lib_protocol_environment/jbuild Normal file
View File

@ -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} ${^}))))

2
src/lib_protocol_environment_sigs/jbuild → src/lib_protocol_environment/sigs/jbuild
View File

@ -63,7 +63,7 @@
)) ))
(action (action
(with-stdout-to ${@} (with-stdout-to ${@}
(chdir ${ROOT} (run ${exe:sigs_packer/sigs_packer.exe} ${^})))))) (chdir ${ROOT} (run ${exe:../sigs_packer/sigs_packer.exe} ${^}))))))
(library (library
((name tezos_protocol_environment_sigs) ((name tezos_protocol_environment_sigs)

0
src/lib_protocol_environment_sigs/v1/RPC_answer.mli → src/lib_protocol_environment/sigs/v1/RPC_answer.mli
View File

0
src/lib_protocol_environment_sigs/v1/RPC_arg.mli → src/lib_protocol_environment/sigs/v1/RPC_arg.mli
View File

0
src/lib_protocol_environment_sigs/v1/RPC_context.mli → src/lib_protocol_environment/sigs/v1/RPC_context.mli
View File

0
src/lib_protocol_environment_sigs/v1/RPC_directory.mli → src/lib_protocol_environment/sigs/v1/RPC_directory.mli
View File

0
src/lib_protocol_environment_sigs/v1/RPC_path.mli → src/lib_protocol_environment/sigs/v1/RPC_path.mli
View File

0
src/lib_protocol_environment_sigs/v1/RPC_query.mli → src/lib_protocol_environment/sigs/v1/RPC_query.mli
View File

0
src/lib_protocol_environment_sigs/v1/RPC_service.mli → src/lib_protocol_environment/sigs/v1/RPC_service.mli
View File

0
src/lib_protocol_environment_sigs/v1/array.mli → src/lib_protocol_environment/sigs/v1/array.mli
View File

0
src/lib_protocol_environment_sigs/v1/base58.mli → src/lib_protocol_environment/sigs/v1/base58.mli
View File

0
src/lib_protocol_environment_sigs/v1/blake2B.mli → src/lib_protocol_environment/sigs/v1/blake2B.mli
View File

0
src/lib_protocol_environment_sigs/v1/block_hash.mli → src/lib_protocol_environment/sigs/v1/block_hash.mli
View File

0
src/lib_protocol_environment_sigs/v1/block_header.mli → src/lib_protocol_environment/sigs/v1/block_header.mli
View File

0
src/lib_protocol_environment_sigs/v1/buffer.mli → src/lib_protocol_environment/sigs/v1/buffer.mli
View File

0
src/lib_protocol_environment_sigs/v1/bytes.mli → src/lib_protocol_environment/sigs/v1/bytes.mli
View File

0
src/lib_protocol_environment_sigs/v1/compare.mli → src/lib_protocol_environment/sigs/v1/compare.mli
View File

0
src/lib_protocol_environment_sigs/v1/context.mli → src/lib_protocol_environment/sigs/v1/context.mli
View File

0
src/lib_protocol_environment_sigs/v1/context_hash.mli → src/lib_protocol_environment/sigs/v1/context_hash.mli
View File

0
src/lib_protocol_environment_sigs/v1/data_encoding.mli → src/lib_protocol_environment/sigs/v1/data_encoding.mli
View File

0
src/lib_protocol_environment_sigs/v1/ed25519.mli → src/lib_protocol_environment/sigs/v1/ed25519.mli
View File

0
src/lib_protocol_environment_sigs/v1/error_monad.mli → src/lib_protocol_environment/sigs/v1/error_monad.mli
View File

0
src/lib_protocol_environment_sigs/v1/fitness.mli → src/lib_protocol_environment/sigs/v1/fitness.mli
View File

0
src/lib_protocol_environment_sigs/v1/format.mli → src/lib_protocol_environment/sigs/v1/format.mli
View File

0
src/lib_protocol_environment_sigs/v1/int32.mli → src/lib_protocol_environment/sigs/v1/int32.mli
View File

0
src/lib_protocol_environment_sigs/v1/int64.mli → src/lib_protocol_environment/sigs/v1/int64.mli
View File

0
src/lib_protocol_environment_sigs/v1/json.mli → src/lib_protocol_environment/sigs/v1/json.mli
View File

0
src/lib_protocol_environment_sigs/v1/list.mli → src/lib_protocol_environment/sigs/v1/list.mli
View File

0
src/lib_protocol_environment_sigs/v1/logging.mli → src/lib_protocol_environment/sigs/v1/logging.mli
View File

0
src/lib_protocol_environment_sigs/v1/lwt.mli → src/lib_protocol_environment/sigs/v1/lwt.mli
View File

0
src/lib_protocol_environment_sigs/v1/lwt_list.mli → src/lib_protocol_environment/sigs/v1/lwt_list.mli
View File

0
src/lib_protocol_environment_sigs/v1/lwt_sequence.mli → src/lib_protocol_environment/sigs/v1/lwt_sequence.mli
View File

0
src/lib_protocol_environment_sigs/v1/mBytes.mli → src/lib_protocol_environment/sigs/v1/mBytes.mli
View File

0
src/lib_protocol_environment_sigs/v1/map.mli → src/lib_protocol_environment/sigs/v1/map.mli
View File

0
src/lib_protocol_environment_sigs/v1/micheline.mli → src/lib_protocol_environment/sigs/v1/micheline.mli
View File

0
src/lib_protocol_environment_sigs/v1/operation.mli → src/lib_protocol_environment/sigs/v1/operation.mli
View File

0
src/lib_protocol_environment_sigs/v1/operation_hash.mli → src/lib_protocol_environment/sigs/v1/operation_hash.mli
View File

0
src/lib_protocol_environment_sigs/v1/operation_list_hash.mli → src/lib_protocol_environment/sigs/v1/operation_list_hash.mli
View File

0
src/lib_protocol_environment_sigs/v1/operation_list_list_hash.mli → src/lib_protocol_environment/sigs/v1/operation_list_list_hash.mli
View File

0
src/lib_protocol_environment_sigs/v1/option.mli → src/lib_protocol_environment/sigs/v1/option.mli
View File

0
src/lib_protocol_environment_sigs/v1/pervasives.mli → src/lib_protocol_environment/sigs/v1/pervasives.mli
View File

0
src/lib_protocol_environment_sigs/v1/protocol.mli → src/lib_protocol_environment/sigs/v1/protocol.mli
View File

0
src/lib_protocol_environment_sigs/v1/protocol_hash.mli → src/lib_protocol_environment/sigs/v1/protocol_hash.mli
View File

0
src/lib_protocol_environment_sigs/v1/s.mli → src/lib_protocol_environment/sigs/v1/s.mli
View File

0
src/lib_protocol_environment_sigs/v1/set.mli → src/lib_protocol_environment/sigs/v1/set.mli
View File

0
src/lib_protocol_environment_sigs/v1/string.mli → src/lib_protocol_environment/sigs/v1/string.mli
View File

0
src/lib_protocol_environment_sigs/v1/tezos_data.mli → src/lib_protocol_environment/sigs/v1/tezos_data.mli
View File

0
src/lib_protocol_environment_sigs/v1/time.mli → src/lib_protocol_environment/sigs/v1/time.mli
View File

6
src/lib_protocol_environment_sigs/v1/updater.mli → src/lib_protocol_environment/sigs/v1/updater.mli
View File

@ -158,12 +158,6 @@ module type PROTOCOL = sig
end 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 (** Activates a given protocol version from a given context. This
means that the context used for the next block will use this means that the context used for the next block will use this
version (this is not an immediate change). The version must have version (this is not an immediate change). The version must have

0
src/lib_protocol_environment_sigs/v1/z.mli → src/lib_protocol_environment/sigs/v1/z.mli
View File

3
src/lib_protocol_environment_sigs/sigs_packer/jbuild → src/lib_protocol_environment/sigs_packer/jbuild
View File

@ -2,7 +2,8 @@
(executable (executable
((name sigs_packer) ((name sigs_packer)
(public_name tezos-protocol-environment-sigs.packer))) (public_name tezos-protocol-environment-sigs.packer)
(package tezos-protocol-environment-sigs)))
(alias (alias
((name runtest_indent) ((name runtest_indent)

0
src/lib_protocol_environment_sigs/sigs_packer/sigs_packer.ml → src/lib_protocol_environment/sigs_packer/sigs_packer.ml
View File

0
src/lib_protocol_environment_client/test/assert.ml → src/lib_protocol_environment/test/assert.ml
View File

5
src/lib_protocol_environment_client/test/jbuild → src/lib_protocol_environment/test/jbuild
View File

@ -3,12 +3,12 @@
(executables (executables
((names (test)) ((names (test))
(libraries (tezos-base (libraries (tezos-base
tezos-protocol-environment-client tezos-protocol-environment
alcotest-lwt)) alcotest-lwt))
(flags (:standard -w -9-32 (flags (:standard -w -9-32
-safe-string -safe-string
-open Tezos_base__TzPervasives -open Tezos_base__TzPervasives
-open Tezos_protocol_environment_client)))) -open Tezos_protocol_environment))))
(alias (alias
((name buildtest) ((name buildtest)
@ -16,6 +16,7 @@
(alias (alias
((name runtest) ((name runtest)
(package tezos-protocol-environment)
(action (run ${exe:test.exe})))) (action (run ${exe:test.exe}))))
(alias (alias

2
src/lib_protocol_environment_client/test/test.ml → src/lib_protocol_environment/test/test.ml
View File

@ -8,6 +8,6 @@
(**************************************************************************) (**************************************************************************)
let () = let () =
Alcotest.run "tezos-protocol-environment-client" [ Alcotest.run "tezos-protocol-environment-shell" [
"mem_context", Test_mem_context.tests ; "mem_context", Test_mem_context.tests ;
] ]

82
src/lib_protocol_environment_client/test/test_mem_context.ml → src/lib_protocol_environment/test/test_mem_context.ml
View File

@ -7,35 +7,35 @@
(* *) (* *)
(**************************************************************************) (**************************************************************************)
open Mem_context open Tezos_protocol_environment_memory
(** Context creation *) (** Context creation *)
let create_block2 ctxt = let create_block2 ctxt =
set ctxt ["a"; "b"] (MBytes.of_string "Novembre") >>= fun ctxt -> Context.set ctxt ["a"; "b"] (MBytes.of_string "Novembre") >>= fun ctxt ->
set ctxt ["a"; "c"] (MBytes.of_string "Juin") >>= fun ctxt -> Context.set ctxt ["a"; "c"] (MBytes.of_string "Juin") >>= fun ctxt ->
set ctxt ["version";] (MBytes.of_string "0.0") >>= fun ctxt -> Context.set ctxt ["version";] (MBytes.of_string "0.0") >>= fun ctxt ->
Lwt.return ctxt Lwt.return ctxt
let create_block3a ctxt = let create_block3a ctxt =
del ctxt ["a"; "b"] >>= fun ctxt -> Context.del ctxt ["a"; "b"] >>= fun ctxt ->
set ctxt ["a"; "d"] (MBytes.of_string "Mars") >>= fun ctxt -> Context.set ctxt ["a"; "d"] (MBytes.of_string "Mars") >>= fun ctxt ->
Lwt.return ctxt Lwt.return ctxt
let create_block3b ctxt = let create_block3b ctxt =
del ctxt ["a"; "c"] >>= fun ctxt -> Context.del ctxt ["a"; "c"] >>= fun ctxt ->
set ctxt ["a"; "d"] (MBytes.of_string "Février") >>= fun ctxt -> Context.set ctxt ["a"; "d"] (MBytes.of_string "Février") >>= fun ctxt ->
Lwt.return ctxt Lwt.return ctxt
type t = { type t = {
genesis: Mem_context.t ; genesis: Context.t ;
block2: Mem_context.t ; block2: Context.t ;
block3a: Mem_context.t ; block3a: Context.t ;
block3b: Mem_context.t ; block3b: Context.t ;
} }
let wrap_context_init f _ () = let wrap_context_init f _ () =
let genesis = Mem_context.empty in let genesis = Context.empty in
create_block2 genesis >>= fun block2 -> create_block2 genesis >>= fun block2 ->
create_block3a block2 >>= fun block3a -> create_block3a block2 >>= fun block3a ->
create_block3b block2 >>= fun block3b -> create_block3b block2 >>= fun block3b ->
@ -49,58 +49,58 @@ let c = function
| Some s -> Some (MBytes.to_string s) | Some s -> Some (MBytes.to_string s)
let test_simple { block2 = ctxt } = 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") ; 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) ; 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) ; Assert.equal_string_option ~msg:__LOC__ (Some "Juin") (c juin) ;
Lwt.return () Lwt.return ()
let test_continuation { block3a = ctxt } = 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) ; 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) ; 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) ; 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) ; Assert.equal_string_option ~msg:__LOC__ (Some "Mars") (c mars) ;
Lwt.return () Lwt.return ()
let test_fork { block3b = ctxt } = 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) ; 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) ; 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) ; 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) ; Assert.equal_string_option ~msg:__LOC__ (Some "Février") (c mars) ;
Lwt.return () Lwt.return ()
let test_replay { genesis = ctxt0 } = let test_replay { genesis = ctxt0 } =
set ctxt0 ["version"] (MBytes.of_string "0.0") >>= fun ctxt1 -> Context.set ctxt0 ["version"] (MBytes.of_string "0.0") >>= fun ctxt1 ->
set ctxt1 ["a"; "b"] (MBytes.of_string "Novembre") >>= fun ctxt2 -> Context.set ctxt1 ["a"; "b"] (MBytes.of_string "Novembre") >>= fun ctxt2 ->
set ctxt2 ["a"; "c"] (MBytes.of_string "Juin") >>= fun ctxt3 -> Context.set ctxt2 ["a"; "c"] (MBytes.of_string "Juin") >>= fun ctxt3 ->
set ctxt3 ["a"; "d"] (MBytes.of_string "July") >>= fun ctxt4a -> Context.set ctxt3 ["a"; "d"] (MBytes.of_string "July") >>= fun ctxt4a ->
set ctxt3 ["a"; "d"] (MBytes.of_string "Juillet") >>= fun ctxt4b -> Context.set ctxt3 ["a"; "d"] (MBytes.of_string "Juillet") >>= fun ctxt4b ->
set ctxt4a ["a"; "b"] (MBytes.of_string "November") >>= fun ctxt5a -> Context.set ctxt4a ["a"; "b"] (MBytes.of_string "November") >>= fun ctxt5a ->
get ctxt4a ["a";"b"] >>= fun novembre -> Context.get ctxt4a ["a";"b"] >>= fun novembre ->
Assert.equal_string_option ~msg:__LOC__ (Some "Novembre") (c 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) ; 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) ; 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) ; 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) ; Assert.equal_string_option ~msg:__LOC__ (Some "Juillet") (c juillet) ;
Lwt.return () Lwt.return ()
let fold_keys s k ~init ~f = let fold_keys s k ~init ~f =
let rec loop k acc = let rec loop k acc =
fold s k ~init:acc Context.fold s k ~init:acc
~f:(fun file acc -> ~f:(fun file acc ->
match file with match file with
| `Key k -> f k acc | `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 keys t = fold_keys t ~init:[] ~f:(fun k acc -> Lwt.return (k :: acc))
let test_fold { genesis = ctxt } = let test_fold { genesis = ctxt } =
set ctxt ["a"; "b"] (MBytes.of_string "Novembre") >>= fun ctxt -> Context.set ctxt ["a"; "b"] (MBytes.of_string "Novembre") >>= fun ctxt ->
set ctxt ["a"; "c"] (MBytes.of_string "Juin") >>= fun ctxt -> Context.set ctxt ["a"; "c"] (MBytes.of_string "Juin") >>= fun ctxt ->
set ctxt ["a"; "d"; "e"] (MBytes.of_string "Septembre") >>= fun ctxt -> Context.set ctxt ["a"; "d"; "e"] (MBytes.of_string "Septembre") >>= fun ctxt ->
set ctxt ["f";] (MBytes.of_string "Avril") >>= fun ctxt -> Context.set ctxt ["f";] (MBytes.of_string "Avril") >>= fun ctxt ->
set ctxt ["g"; "h"] (MBytes.of_string "Avril") >>= fun ctxt -> Context.set ctxt ["g"; "h"] (MBytes.of_string "Avril") >>= fun ctxt ->
keys ctxt [] >>= fun l -> keys ctxt [] >>= fun l ->
Assert.equal_string_list_list ~msg:__LOC__ Assert.equal_string_list_list ~msg:__LOC__
[["a";"b"]; [["a";"b"];

21
src/lib_protocol_environment/tezos-protocol-environment-shell.opam Normal file
View File

@ -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 ]
]

0
src/lib_protocol_environment_sigs/tezos-protocol-environment-sigs.opam → src/lib_protocol_environment/tezos-protocol-environment-sigs.opam
View File

1
src/lib_protocol_environment_client/tezos-protocol-environment-client.opam → src/lib_protocol_environment/tezos-protocol-environment.opam
View File

@ -10,7 +10,6 @@ depends: [
"ocamlfind" { build } "ocamlfind" { build }
"jbuilder" { build & >= "1.0+beta17" } "jbuilder" { build & >= "1.0+beta17" }
"tezos-base" "tezos-base"
"tezos-micheline"
"tezos-protocol-environment-sigs" "tezos-protocol-environment-sigs"
"alcotest-lwt" { test } "alcotest-lwt" { test }
] ]

563
src/lib_protocol_environment/tezos_protocol_environment.ml Normal file
View File

@ -0,0 +1,563 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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
"@[<v 2>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

152
src/lib_protocol_environment/tezos_protocol_environment.mli Normal file
View File

@ -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

32
src/lib_protocol_environment_client/fake_context.ml → src/lib_protocol_environment/tezos_protocol_environment_faked.ml
View File

@ -7,16 +7,24 @@
(* *) (* *)
(**************************************************************************) (**************************************************************************)
type t module Context = struct
type t
type key = string list type key = string list
type value = MBytes.t type value = MBytes.t
let mem _ _ = assert false let mem _ _ = assert false
let dir_mem _ _ = assert false let dir_mem _ _ = assert false
let get _ _ = assert false let get _ _ = assert false
let set _ _ _ = assert false let set _ _ _ = assert false
let del _ _ = assert false let del _ _ = assert false
let remove_rec _ _ = assert false let remove_rec _ _ = assert false
let fold _ _ ~init:_ ~f:_ = assert false let fold _ _ ~init:_ ~f:_ = assert false
let keys _ _ = assert false let keys _ _ = assert false
let fold_keys _ _ ~init:_ ~f:_ = 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)

124
src/lib_protocol_environment/tezos_protocol_environment_memory.ml Normal file
View File

@ -0,0 +1,124 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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:@[<v 2>@ %a@]@ " n pp (Dir m))
m
let dump m = Format.eprintf "@[<v>%a@]" pp m
let set_protocol _ _ = assert false
let fork_test_chain _ ~protocol:_ ~expiration:_ = assert false
end
include Tezos_protocol_environment.Make(Context)

2
src/lib_protocol_environment_client/fake_context.mli → src/lib_protocol_environment/tezos_protocol_environment_node.ml
View File

@ -7,4 +7,4 @@
(* *) (* *)
(**************************************************************************) (**************************************************************************)
include Protocol_environment.CONTEXT include Tezos_protocol_environment.Make(Context)

7
src/lib_protocol_environment_client/mem_context.mli → src/lib_protocol_environment/tezos_protocol_environment_shell.ml
View File

@ -7,9 +7,4 @@
(* *) (* *)
(**************************************************************************) (**************************************************************************)
include Protocol_environment.CONTEXT include Tezos_protocol_environment.Make(Tezos_storage.Context)
val empty : t
val pp : Format.formatter -> t -> unit
val dump : t -> unit

12
src/lib_protocol_environment_client/fake.ml
View File

@ -1,12 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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))()

78
src/lib_protocol_environment_client/fake_updater.ml
View File

@ -1,78 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

11
src/lib_protocol_environment_client/fake_updater.mli
View File

@ -1,11 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
module Make(Context : Protocol_environment.CONTEXT) :
Protocol_environment.UPDATER with module Context := Context

17
src/lib_protocol_environment_client/jbuild
View File

@ -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} ${^}))))

12
src/lib_protocol_environment_client/mem.ml
View File

@ -1,12 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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))()

114
src/lib_protocol_environment_client/mem_context.ml
View File

@ -1,114 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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:@[<v 2>@ %a@]@ " n pp (Dir m))
m
let dump m = Format.eprintf "@[<v>%a@]" pp m

1
src/lib_protocol_updater/jbuild
View File

@ -6,6 +6,7 @@
(libraries (tezos-base (libraries (tezos-base
tezos-stdlib-unix tezos-stdlib-unix
tezos-micheline tezos-micheline
tezos-protocol-environment-shell
tezos-protocol-compiler.registerer tezos-protocol-compiler.registerer
tezos-protocol-compiler.native tezos-protocol-compiler.native
tezos-storage tezos-storage

6
src/lib_protocol_updater/registred_protocol.ml
View File

@ -9,7 +9,7 @@
module type T = sig module type T = sig
val hash: Protocol_hash.t 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 val complete_b58prefix : Context.t -> string -> string list Lwt.t
end end
@ -20,7 +20,7 @@ let build_v1 hash =
let module Name = struct let module Name = struct
let name = Protocol_hash.to_b58check hash let name = Protocol_hash.to_b58check hash
end in end in
let module Env = Protocol_environment.MakeV1(Name)(Context)(Updater)() in let module Env = Tezos_protocol_environment_shell.MakeV1(Name)() in
(module struct (module struct
let hash = hash let hash = hash
module P = F(Env) module P = F(Env)
@ -49,7 +49,7 @@ let get hash =
with Not_found -> None with Not_found -> None
module Register module Register
(Env : Updater.Node_protocol_environment_sigs.V1) (Env : Tezos_protocol_environment_shell.V1)
(Proto : Env.Updater.PROTOCOL) (Proto : Env.Updater.PROTOCOL)
(Source : sig (Source : sig
val hash: Protocol_hash.t option val hash: Protocol_hash.t option

4
src/lib_protocol_updater/registred_protocol.mli
View File

@ -9,7 +9,7 @@
module type T = sig module type T = sig
val hash: Protocol_hash.t 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 val complete_b58prefix : Context.t -> string -> string list Lwt.t
end end
@ -22,7 +22,7 @@ val get_exn: Protocol_hash.t -> t
module Register module Register
(Env : Updater.Node_protocol_environment_sigs.V1) (Env : Tezos_protocol_environment_shell.V1)
(Proto : Env.Updater.PROTOCOL) (Proto : Env.Updater.PROTOCOL)
(Source : sig (Source : sig
val hash: Protocol_hash.t option val hash: Protocol_hash.t option

1
src/lib_protocol_updater/tezos-protocol-updater.opam
View File

@ -12,6 +12,7 @@ depends: [
"tezos-base" "tezos-base"
"tezos-micheline" "tezos-micheline"
"tezos-protocol-compiler" "tezos-protocol-compiler"
"tezos-protocol-environment-shell"
"tezos-stdlib-unix" "tezos-stdlib-unix"
"tezos-storage" "tezos-storage"
] ]

66
src/lib_protocol_updater/updater.ml
View File

@ -11,48 +11,22 @@ open Logging.Updater
let (//) = Filename.concat let (//) = Filename.concat
module Raw = struct (** Compiler *)
type validation_result = { let datadir = ref None
context: Context.t ; let get_datadir () =
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 ;
}
let activate = Context.set_protocol
let fork_test_chain = Context.fork_test_chain
(** Compiler *)
let datadir = ref None
let get_datadir () =
match !datadir with match !datadir with
| None -> | None ->
fatal_error "Node not initialized" ; fatal_error "Node not initialized" ;
Lwt_exit.exit 1 Lwt_exit.exit 1
| Some m -> m | Some m -> m
let init dir = let init dir =
datadir := Some dir datadir := Some dir
let compiler_name = "tezos-protocol-compiler" let compiler_name = "tezos-protocol-compiler"
let do_compile hash p = let do_compile hash p =
assert (p.Protocol.expected_env = V1) ; assert (p.Protocol.expected_env = V1) ;
let datadir = get_datadir () in let datadir = get_datadir () in
let source_dir = datadir // Protocol_hash.to_short_b58check hash // "src" in let source_dir = datadir // Protocol_hash.to_short_b58check hash // "src" in
@ -86,7 +60,7 @@ module Raw = struct
(Dynlink.error_message err) plugin_file; (Dynlink.error_message err) plugin_file;
Lwt.return false Lwt.return false
let compile hash p = let compile hash p =
if Tezos_protocol_registerer.Registerer.mem hash then if Tezos_protocol_registerer.Registerer.mem hash then
Lwt.return true Lwt.return true
else begin else begin
@ -96,29 +70,3 @@ module Raw = struct
log_error "Internal error while compiling %a" Protocol_hash.pp hash; log_error "Internal error while compiling %a" Protocol_hash.pp hash;
Lwt.return loaded Lwt.return loaded
end 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)()

52
src/lib_protocol_updater/updater.mli
View File

@ -7,60 +7,8 @@
(* *) (* *)
(**************************************************************************) (**************************************************************************)
(* See `src/environment/v1/updater.mli` for documentation. *)
val compile: Protocol_hash.t -> Protocol.t -> bool Lwt.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
val init: string -> unit 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 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

4
src/lib_shell/block_validator.ml
View File

@ -124,8 +124,8 @@ let apply_block
(fun i ops quota -> (fun i ops quota ->
fail_unless fail_unless
(Option.unopt_map ~default:true (Option.unopt_map ~default:true
~f:(fun max -> List.length ops <= max) quota.Updater.max_op) ~f:(fun max -> List.length ops <= max) quota.Tezos_protocol_environment_shell.max_op)
(let max = Option.unopt ~default:~-1 quota.Updater.max_op in (let max = Option.unopt ~default:~-1 quota.max_op in
invalid_block hash @@ invalid_block hash @@
Too_many_operations Too_many_operations
{ pass = i + 1 ; found = List.length ops ; max }) >>=? fun () -> { pass = i + 1 ; found = List.length ops ; max }) >>=? fun () ->

2
src/lib_shell/distributed_db.mli
View File

@ -125,7 +125,7 @@ val commit_block:
chain_db -> chain_db ->
Block_hash.t -> Block_hash.t ->
Block_header.t -> Operation.t list list -> Block_header.t -> Operation.t list list ->
Updater.validation_result -> Tezos_protocol_environment_shell.validation_result ->
State.Block.t option tzresult Lwt.t State.Block.t option tzresult Lwt.t
(** Store on disk all the data associated to an invalid block. *) (** Store on disk all the data associated to an invalid block. *)

7
src/lib_shell/node.ml
View File

@ -310,11 +310,11 @@ module RPC = struct
test_chain ; 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_hash = State.Block.hash block in
let block_header = State.Block.header block in let block_header = State.Block.header block in
State.Block.context block >|= fun context -> State.Block.context block >|= fun context ->
{ Updater.block_hash ; { Tezos_protocol_environment_shell.block_hash ;
block_header ; block_header ;
operation_hashes = (fun () -> State.Block.all_operation_hashes block) ; operation_hashes = (fun () -> State.Block.all_operation_hashes block) ;
operations = (fun () -> State.Block.all_operations block) ; operations = (fun () -> State.Block.all_operations block) ;
@ -370,7 +370,8 @@ module RPC = struct
Operation_list_list_hash.compute Operation_list_list_hash.compute
(List.map Operation_list_hash.compute operation_hashes) in (List.map Operation_list_hash.compute operation_hashes) in
Lwt.return (Some { Lwt.return (Some {
Updater.block_hash = prevalidation_hash ; Tezos_protocol_environment_shell.
block_hash = prevalidation_hash ;
block_header = { block_header = {
shell = { shell = {
level = Int32.succ head_header.shell.level ; level = Int32.succ head_header.shell.level ;

3
src/lib_shell/prevalidation.mli
View File

@ -21,4 +21,5 @@ val prevalidate :
(prevalidation_state * error Preapply_result.t) Lwt.t (prevalidation_state * error Preapply_result.t) Lwt.t
val end_prevalidation : val end_prevalidation :
prevalidation_state -> Updater.validation_result tzresult Lwt.t prevalidation_state ->
Tezos_protocol_environment_shell.validation_result tzresult Lwt.t

2
src/lib_shell/prevalidator.mli
View File

@ -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 flush: t -> Block_hash.t -> unit tzresult Lwt.t
val timestamp: t -> Time.t val timestamp: t -> Time.t
val operations: t -> error Preapply_result.t * Operation.t Operation_hash.Map.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 pending: ?block:State.Block.t -> t -> Operation.t Operation_hash.Map.t Lwt.t
val running_workers: unit -> (Chain_id.t * t) list val running_workers: unit -> (Chain_id.t * t) list

4
src/lib_shell/state.ml
View File

@ -570,8 +570,8 @@ module Block = struct
let store let store
?(dont_enforce_context_hash = false) ?(dont_enforce_context_hash = false)
chain_state block_header operations chain_state block_header operations
{ Updater.context ; message ; max_operations_ttl ; { Tezos_protocol_environment_shell.context ; message ;
max_operation_data_length } = max_operations_ttl ; max_operation_data_length } =
let bytes = Block_header.to_bytes block_header in let bytes = Block_header.to_bytes block_header in
let hash = Block_header.hash_raw bytes in let hash = Block_header.hash_raw bytes in
(* let's the validator check the consistency... of fitness, level, ... *) (* let's the validator check the consistency... of fitness, level, ... *)

2
src/lib_shell/state.mli
View File

@ -112,7 +112,7 @@ module Block : sig
Chain.t -> Chain.t ->
Block_header.t -> Block_header.t ->
Operation.t list list -> Operation.t list list ->
Updater.validation_result -> Tezos_protocol_environment_shell.validation_result ->
block option tzresult Lwt.t block option tzresult Lwt.t
val store_invalid: val store_invalid:

2
src/lib_shell/test/test_locator.ml
View File

@ -89,7 +89,7 @@ let make_empty_chain (chain:State.Chain.t) n : Block_hash.t Lwt.t =
Context.commit Context.commit
~time:header.shell.timestamp empty_context >>= fun context -> ~time:header.shell.timestamp empty_context >>= fun context ->
let header = { header with shell = { header.shell with context } } in 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 ; context = empty_context ;
fitness = [] ; fitness = [] ;
message = None ; message = None ;

6
src/proto_alpha/lib_baking/jbuild
View File

@ -5,7 +5,7 @@
(public_name tezos-baking-alpha) (public_name tezos-baking-alpha)
(libraries (tezos-base (libraries (tezos-base
tezos-protocol-alpha tezos-protocol-alpha
tezos-protocol-environment-client tezos-protocol-environment
tezos-shell-services tezos-shell-services
tezos-client-base tezos-client-base
tezos-client-alpha tezos-client-alpha
@ -27,7 +27,7 @@
(public_name tezos-baking-alpha-commands) (public_name tezos-baking-alpha-commands)
(libraries (tezos-base (libraries (tezos-base
tezos-protocol-alpha tezos-protocol-alpha
tezos-protocol-environment-client tezos-protocol-environment
tezos-shell-services tezos-shell-services
tezos-client-base tezos-client-base
tezos-client-alpha tezos-client-alpha
@ -50,7 +50,7 @@
(public_name tezos-baking-alpha-commands.registration) (public_name tezos-baking-alpha-commands.registration)
(libraries (tezos-base (libraries (tezos-base
tezos-protocol-alpha tezos-protocol-alpha
tezos-protocol-environment-client tezos-protocol-environment
tezos-shell-services tezos-shell-services
tezos-client-base tezos-client-base
tezos-client-alpha tezos-client-alpha

2
src/proto_alpha/lib_baking/tezos-baking-alpha-commands.opam
View File

@ -10,7 +10,7 @@ depends: [
"ocamlfind" { build } "ocamlfind" { build }
"jbuilder" { build & >= "1.0+beta17" } "jbuilder" { build & >= "1.0+beta17" }
"tezos-base" "tezos-base"
"tezos-protocol-environment-client" "tezos-protocol-environment"
"tezos-protocol-alpha" "tezos-protocol-alpha"
"tezos-shell-services" "tezos-shell-services"
"tezos-client-base" "tezos-client-base"

2
src/proto_alpha/lib_baking/tezos-baking-alpha.opam
View File

@ -10,7 +10,7 @@ depends: [
"ocamlfind" { build } "ocamlfind" { build }
"jbuilder" { build & >= "1.0+beta17" } "jbuilder" { build & >= "1.0+beta17" }
"tezos-base" "tezos-base"
"tezos-protocol-environment-client" "tezos-protocol-environment"
"tezos-protocol-alpha" "tezos-protocol-alpha"
"tezos-shell-services" "tezos-shell-services"
"tezos-client-base" "tezos-client-base"

2
src/proto_alpha/lib_client/jbuild
View File

@ -5,7 +5,7 @@
(public_name tezos-client-alpha) (public_name tezos-client-alpha)
(libraries (tezos-base (libraries (tezos-base
tezos-protocol-alpha tezos-protocol-alpha
tezos-protocol-environment-client tezos-protocol-environment
tezos-shell-services tezos-shell-services
tezos-client-base tezos-client-base
tezos-rpc)) tezos-rpc))

2
src/proto_alpha/lib_client/proto_alpha.ml
View File

@ -8,7 +8,7 @@
(**************************************************************************) (**************************************************************************)
module Name = struct let name = "alpha" end 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) include Tezos_protocol_alpha.Functor.Make(Alpha_environment)
let hash = let hash =

2
src/proto_alpha/lib_client/tezos-client-alpha.opam
View File

@ -10,7 +10,7 @@ depends: [
"ocamlfind" { build } "ocamlfind" { build }
"jbuilder" { build & >= "1.0+beta17" } "jbuilder" { build & >= "1.0+beta17" }
"tezos-base" "tezos-base"
"tezos-protocol-environment-client" "tezos-protocol-environment"
"tezos-protocol-alpha" "tezos-protocol-alpha"
"tezos-shell-services" "tezos-shell-services"
"tezos-client-base" "tezos-client-base"

4
src/proto_alpha/lib_client_commands/jbuild
View File

@ -5,7 +5,7 @@
(public_name tezos-client-alpha-commands) (public_name tezos-client-alpha-commands)
(libraries (tezos-base (libraries (tezos-base
tezos-protocol-alpha tezos-protocol-alpha
tezos-protocol-environment-client tezos-protocol-environment
tezos-shell-services tezos-shell-services
tezos-client-base tezos-client-base
tezos-client-alpha tezos-client-alpha
@ -27,7 +27,7 @@
(public_name tezos-client-alpha-commands.registration) (public_name tezos-client-alpha-commands.registration)
(libraries (tezos-base (libraries (tezos-base
tezos-protocol-alpha tezos-protocol-alpha
tezos-protocol-environment-client tezos-protocol-environment
tezos-shell-services tezos-shell-services
tezos-client-base tezos-client-base
tezos-client-alpha tezos-client-alpha

Some files were not shown because too many files have changed in this diff Show More