Refactor: move Registred_protocol from State to Tezos_updater

This commit is contained in:
Grégoire Henry 2018-02-05 19:40:16 +01:00
parent 2498da2815
commit 971c3c4b21
20 changed files with 135 additions and 122 deletions

View File

@ -92,7 +92,7 @@ let init_logger ?verbosity (log_config : Node_config_file.log) =
let init_node ?sandbox (config : Node_config_file.t) =
let patch_context json ctxt =
let module Proto = (val State.Registred_protocol.get_exn genesis.protocol) in
let module Proto = (val Registred_protocol.get_exn genesis.protocol) in
Lwt_utils.protect begin fun () ->
Proto.configure_sandbox ctxt json
end >|= function

View File

@ -55,7 +55,7 @@ let () = Format.kasprintf Jbuild_plugin.V1.send {|
((name tezos_embedded_protocol_%s)
(public_name tezos-embedded-protocol-%s)
(library_flags (:standard -linkall))
(libraries (tezos_embedded_raw_protocol_%s tezos-shell))
(libraries (tezos_embedded_raw_protocol_%s tezos-protocol-updater))
(modules (Registerer))))
|}
version version version version version version version version

View File

@ -26,7 +26,7 @@ end
let () =
Format.printf {|
let () =
let module Ignored = Tezos_shell.State.Register_embedded_protocol
let module Ignored = Tezos_protocol_updater.Registred_protocol.Register
(Tezos_embedded_protocol_environment_%s.Environment)
(Tezos_embedded_raw_protocol_%s.Main)
(Source) in

View File

@ -0,0 +1,78 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
module type T = sig
val hash: Protocol_hash.t
include Updater.NODE_PROTOCOL
val complete_b58prefix : Context.t -> string -> string list Lwt.t
end
type t = (module T)
let build_v1 hash =
let (module F) = Tezos_protocol_registerer.Registerer.get_exn hash in
let module Name = struct
let name = Protocol_hash.to_b58check hash
end in
let module Env = Protocol_environment.MakeV1(Name)(Context)(Updater)() in
(module struct
let hash = hash
module P = F(Env)
include P
include Updater.LiftProtocol(Name)(Env)(P)
let complete_b58prefix = Env.Context.complete
end : T)
module VersionTable = Protocol_hash.Table
let versions : (module T) VersionTable.t =
VersionTable.create 20
let mem hash =
VersionTable.mem versions hash ||
Tezos_protocol_registerer.Registerer.mem hash
let get_exn hash =
try VersionTable.find versions hash
with Not_found ->
let proto = build_v1 hash in
VersionTable.add versions hash proto ;
proto
let get hash =
try Some (get_exn hash)
with Not_found -> None
module Register
(Env : Updater.Node_protocol_environment_sigs.V1)
(Proto : Env.Updater.PROTOCOL)
(Source : sig
val hash: Protocol_hash.t option
val sources: Protocol.t
end) = struct
let () =
let hash =
match Source.hash with
| None -> Protocol.hash Source.sources
| Some hash -> hash in
let module Name = struct
let name = Protocol_hash.to_b58check hash
end in
(* TODO add a memory table for "embedded" sources... *)
VersionTable.add
versions hash
(module struct
let hash = hash
include Proto
include Updater.LiftProtocol(Name)(Env)(Proto)
let complete_b58prefix = Env.Context.complete
end : T)
end

View File

@ -0,0 +1,30 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2017. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
module type T = sig
val hash: Protocol_hash.t
include Updater.NODE_PROTOCOL
val complete_b58prefix : Context.t -> string -> string list Lwt.t
end
type t = (module T)
val mem: Protocol_hash.t -> bool
val get: Protocol_hash.t -> t option
val get_exn: Protocol_hash.t -> t
module Register
(Env : Updater.Node_protocol_environment_sigs.V1)
(Proto : Env.Updater.PROTOCOL)
(Source : sig
val hash: Protocol_hash.t option
val sources: Protocol.t
end) : sig end

View File

@ -114,7 +114,7 @@ let check_liveness net_state pred hash operations_hashes operations =
let apply_block
net_state
pred (module Proto : State.Registred_protocol.T)
pred (module Proto : Registred_protocol.T)
hash (header: Block_header.t)
operations =
let pred_header = State.Block.header pred
@ -207,7 +207,7 @@ let check_net_liveness net_db hash (header: Block_header.t) =
let get_proto pred hash =
State.Block.context pred >>= fun pred_context ->
Context.get_protocol pred_context >>= fun pred_protocol_hash ->
match State.Registred_protocol.get pred_protocol_hash with
match Registred_protocol.get pred_protocol_hash with
| None ->
fail (Unavailable_protocol { block = hash ;
protocol = pred_protocol_hash })

View File

@ -32,7 +32,7 @@ val fetch_and_compile_protocol:
t ->
?peer:P2p_peer.Id.t ->
?timeout:float ->
Protocol_hash.t -> State.Registred_protocol.t tzresult Lwt.t
Protocol_hash.t -> Registred_protocol.t tzresult Lwt.t
val shutdown: t -> unit Lwt.t

View File

@ -546,7 +546,7 @@ module RPC = struct
| None -> Lwt.fail Not_found
| Some { context = ctxt } ->
Context.get_protocol ctxt >>= fun protocol_hash ->
let (module Proto) = State.Registred_protocol.get_exn protocol_hash in
let (module Proto) = Registred_protocol.get_exn protocol_hash in
Base58.complete str >>= fun l1 ->
Proto.complete_b58prefix ctxt str >>= fun l2 ->
Lwt.return (l1 @ l2)
@ -556,7 +556,7 @@ module RPC = struct
| None -> Lwt.return None
| Some rpc_context ->
Context.get_protocol rpc_context.context >>= fun protocol_hash ->
let (module Proto) = State.Registred_protocol.get_exn protocol_hash in
let (module Proto) = Registred_protocol.get_exn protocol_hash in
let dir = RPC_directory.map (fun () -> rpc_context) Proto.rpc_services in
Lwt.return (Some (RPC_directory.map (fun _ -> ()) dir))

View File

@ -53,7 +53,7 @@ type prevalidation_state =
-> prevalidation_state
and 'a proto =
(module State.Registred_protocol.T with type validation_state = 'a)
(module Registred_protocol.T with type validation_state = 'a)
let start_prevalidation
?proto_header
@ -69,7 +69,7 @@ let start_prevalidation
Context.get_protocol predecessor_context >>= fun protocol ->
let predecessor = State.Block.hash predecessor in
begin
match State.Registred_protocol.get protocol with
match Registred_protocol.get protocol with
| None ->
(* FIXME. *)
(* This should not happen: it should be handled in the validator. *)

View File

@ -13,7 +13,7 @@ type 'a request =
| Request_validation: {
hash: Protocol_hash.t ;
protocol: Protocol.t ;
} -> State.Registred_protocol.t tzresult request
} -> Registred_protocol.t tzresult request
type message = Message: 'a request * 'a Lwt.u option -> message
@ -98,7 +98,7 @@ let rec worker_loop bv =
return ()
| Some wakener ->
if valid then
match State.Registred_protocol.get hash with
match Registred_protocol.get hash with
| Some protocol ->
Lwt.wakeup_later wakener (Ok protocol)
| None ->
@ -145,7 +145,7 @@ let shutdown { canceler ; worker } =
worker
let validate { messages } hash protocol =
match State.Registred_protocol.get hash with
match Registred_protocol.get hash with
| Some protocol ->
lwt_debug "previously validated protocol %a (before pipe)"
Protocol_hash.pp_short hash >>= fun () ->
@ -160,7 +160,7 @@ let validate { messages } hash protocol =
res
let fetch_and_compile_protocol pv ?peer ?timeout hash =
match State.Registred_protocol.get hash with
match Registred_protocol.get hash with
| Some proto -> return proto
| None ->
begin

View File

@ -22,7 +22,7 @@ val create: Distributed_db.t -> t
val validate:
t ->
Protocol_hash.t -> Protocol.t ->
State.Registred_protocol.t tzresult Lwt.t
Registred_protocol.t tzresult Lwt.t
val shutdown: t -> unit Lwt.t
@ -30,7 +30,7 @@ val fetch_and_compile_protocol:
t ->
?peer:P2p_peer.Id.t ->
?timeout:float ->
Protocol_hash.t -> State.Registred_protocol.t tzresult Lwt.t
Protocol_hash.t -> Registred_protocol.t tzresult Lwt.t
val fetch_and_compile_protocols:
t ->

View File

@ -691,80 +691,6 @@ module Protocol = struct
end
module Registred_protocol = struct
module type T = sig
val hash: Protocol_hash.t
include Updater.NODE_PROTOCOL
val complete_b58prefix : Context.t -> string -> string list Lwt.t
end
type t = (module T)
let build_v1 hash =
let (module F) = Tezos_protocol_registerer.Registerer.get_exn hash in
let module Name = struct
let name = Protocol_hash.to_b58check hash
end in
let module Env = Updater.MakeV1(Name)() in
(module struct
let hash = hash
module P = F(Env)
include P
include Updater.LiftProtocol(Name)(Env)(P)
let complete_b58prefix = Env.Context.complete
end : T)
module VersionTable = Protocol_hash.Table
let versions : (module T) VersionTable.t =
VersionTable.create 20
let mem hash =
VersionTable.mem versions hash ||
Tezos_protocol_registerer.Registerer.mem hash
let get_exn hash =
try VersionTable.find versions hash
with Not_found ->
let proto = build_v1 hash in
VersionTable.add versions hash proto ;
proto
let get hash =
try Some (get_exn hash)
with Not_found -> None
end
module Register_embedded_protocol
(Env : Updater.Node_protocol_environment_sigs.V1)
(Proto : Env.Updater.PROTOCOL)
(Source : sig
val hash: Protocol_hash.t option
val sources: Protocol.t
end) = struct
let () =
let hash =
match Source.hash with
| None -> Protocol.hash Source.sources
| Some hash -> hash in
let module Name = struct
let name = Protocol_hash.to_b58check hash
end in
(* TODO add a memory table for "embedded" sources... *)
Registred_protocol.VersionTable.add
Registred_protocol.versions hash
(module struct
let hash = hash
include Proto
include Updater.LiftProtocol(Name)(Env)(Proto)
let complete_b58prefix = Env.Context.complete
end : Registred_protocol.T)
end
module Current_mempool = struct
let set net_state ~head mempool =

View File

@ -213,23 +213,6 @@ module Protocol : sig
end
module Registred_protocol : sig
module type T = sig
val hash: Protocol_hash.t
include Updater.NODE_PROTOCOL
val complete_b58prefix : Context.t -> string -> string list Lwt.t
end
type t = (module T)
val mem: Protocol_hash.t -> bool
val get: Protocol_hash.t -> t option
val get_exn: Protocol_hash.t -> t
end
module Current_mempool : sig
val get: Net.t -> (Block_header.t * Mempool.t) Lwt.t
@ -241,10 +224,3 @@ module Current_mempool : sig
end
module Register_embedded_protocol
(Env : Updater.Node_protocol_environment_sigs.V1)
(Proto : Env.Updater.PROTOCOL)
(Source : sig
val hash: Protocol_hash.t option
val sources: Protocol.t
end) : sig end

View File

@ -4,6 +4,7 @@
((names (test_state))
(libraries (tezos-base
tezos-storage
tezos-protocol-updater
tezos-shell
tezos-embedded-protocol-demo
tezos-test-helpers))
@ -12,6 +13,7 @@
-open Tezos_base__TzPervasives
-open Tezos_test_helpers
-open Tezos_storage
-open Tezos_protocol_updater
-open Tezos_shell))))
(alias

View File

@ -22,7 +22,7 @@ let genesis_protocol =
let genesis_time =
Time.of_seconds 0L
module Proto = (val State.Registred_protocol.get_exn genesis_protocol)
module Proto = (val Registred_protocol.get_exn genesis_protocol)
let genesis : State.Net.genesis = {
time = genesis_time ;

View File

@ -16,11 +16,11 @@ let no_ops_hash =
[Operation_list_hash.empty]
let get_protocol hash : (module State.Registred_protocol.T) =
let (module Protocol): (module State.Registred_protocol.T) =
let get_protocol hash : (module Registred_protocol.T) =
let (module Protocol): (module Registred_protocol.T) =
Option.unopt_exn
Unknown_protocol
@@ State.Registred_protocol.get hash
@@ Registred_protocol.get hash
in
(module Protocol)

View File

@ -15,7 +15,7 @@ exception Unknown_protocol
(** Miscellaneous self-descriptive functions *)
val no_ops_hash : Operation_list_list_hash.t
val get_protocol : Protocol_hash.t -> (module State.Registred_protocol.T)
val get_protocol : Protocol_hash.t -> (module Tezos_protocol_updater.Registred_protocol.T)
val get_shell_header :
State.Block.t -> Tezos_base.Operation.shell_header
val get_block_header :

View File

@ -5,11 +5,14 @@
(libraries (tezos-test-helpers
tezos-base
tezos-embedded-protocol-genesis
tezos-embedded-protocol-alpha))
tezos-embedded-protocol-alpha
tezos-protocol-updater
tezos-shell))
(wrapped false)
(flags (:standard -w -9-32 -safe-string
-open Tezos_base__TzPervasives
-open Tezos_test_helpers
-open Tezos_protocol_updater
-open Tezos_embedded_raw_protocol_alpha))))
(alias

View File

@ -11,7 +11,6 @@ depends: [
"jbuilder" { build & >= "1.0+beta15" }
"tezos-protocol-compiler"
"tezos-protocol-updater"
"tezos-shell"
]
build: [
[ "rm" "jbuild" "src/jbuild" ]

View File

@ -11,7 +11,6 @@ depends: [
"jbuilder" { build & >= "1.0+beta15" }
"tezos-protocol-compiler"
"tezos-protocol-updater"
"tezos-shell"
]
build: [
[ "rm" "jbuild" "src/jbuild" ]