Refactor: move Registred_protocol from State to Tezos_updater

src/bin_node/node_run_command.ml

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

src/lib_protocol_compiler/jbuild_embedded_protocol_template

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

src/lib_protocol_compiler/main_embedded_packer.ml

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

src/lib_protocol_updater/registred_protocol.ml

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

src/lib_protocol_updater/registred_protocol.mli

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

src/lib_shell/block_validator.ml

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

src/lib_shell/block_validator.mli

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

src/lib_shell/node.ml

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

src/lib_shell/prevalidation.ml

@@ -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. *)

src/lib_shell/protocol_validator.ml

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

src/lib_shell/protocol_validator.mli

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

src/lib_shell/state.ml

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

src/lib_shell/state.mli

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

src/lib_shell/test/jbuild

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

src/lib_shell/test/test_state.ml

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

src/proto_alpha/lib_protocol/test/helpers/helpers_misc.ml

@@ -16,11 +16,11 @@ let no_ops_hash =
     [Operation_list_hash.empty]
 
 
-let get_protocol hash : (module State.Registred_protocol.T) =
+let get_protocol hash : (module Registred_protocol.T) =
-  let (module Protocol): (module State.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)
 

src/proto_alpha/lib_protocol/test/helpers/helpers_misc.mli

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

src/proto_alpha/lib_protocol/test/helpers/jbuild

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

src/proto_demo/lib_protocol/tezos-embedded-protocol-demo.opam

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

src/proto_genesis/lib_protocol/tezos-embedded-protocol-genesis.opam

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