Base: move Protocol.Meta from lib_protocol_compiler to lib_base

lib_base/protocol.ml

@@ -7,6 +7,8 @@
 (*                                                                        *)
 (**************************************************************************)
 
+let (//) = Filename.concat
+
 type t = {
   expected_env: env_version ;
   components: component list ;
@@ -69,3 +71,104 @@ let of_bytes b = Data_encoding.Binary.of_bytes encoding b
 let of_bytes_exn b = Data_encoding.Binary.of_bytes_exn encoding b
 let hash proto = Protocol_hash.hash_bytes [to_bytes proto]
 let hash_raw proto = Protocol_hash.hash_bytes [proto]
+
+module Meta = struct
+
+  type t = {
+    hash: Protocol_hash.t option ;
+    expected_env_version: env_version option ;
+    modules: string list ;
+  }
+
+  let name = "TEZOS_PROTOCOL"
+
+  let encoding =
+    let open Data_encoding in
+    conv
+      (fun { hash ; expected_env_version ; modules } ->
+         (hash, expected_env_version, modules))
+      (fun (hash, expected_env_version, modules) ->
+         { hash ; expected_env_version ; modules }) @@
+    obj3
+      (opt "hash"
+         ~description:"Used to force the hash of the protocol"
+         Protocol_hash.encoding)
+      (opt "expected_env_version"
+         env_version_encoding)
+      (req "modules"
+         ~description:"Modules comprising the protocol"
+         (list string))
+
+  let to_file ~dir:dirname ?hash ?env_version modules =
+    let config_file =
+      Data_encoding.Json.construct
+        encoding
+        { hash ; expected_env_version = env_version ; modules } in
+    Utils.write_file ~bin:false (dirname // name) @@
+    Data_encoding_ezjsonm.to_string config_file
+
+  let of_file ~dir:dirname =
+    Utils.read_file ~bin:false (dirname // name) |>
+    Data_encoding_ezjsonm.from_string |> function
+    | Error err -> Pervasives.failwith err
+    | Ok json -> Data_encoding.Json.destruct encoding json
+
+end
+
+let find_component dirname module_name =
+  let name_lowercase = String.uncapitalize_ascii module_name in
+  let implementation = dirname // name_lowercase ^ ".ml" in
+  let interface = implementation ^ "i" in
+  match Sys.file_exists implementation, Sys.file_exists interface with
+  | false, _ -> Pervasives.failwith @@ "Not such file: " ^ implementation
+  | true, false ->
+      let implementation = Utils.read_file ~bin:false implementation in
+      { name = module_name; interface = None; implementation }
+  | _ ->
+      let interface = Utils.read_file ~bin:false interface in
+      let implementation = Utils.read_file ~bin:false implementation in
+      { name = module_name; interface = Some interface; implementation }
+
+let read_dir dir =
+  let meta = Meta.of_file ~dir in
+  let components = List.map (find_component dir) meta.modules in
+  let expected_env =
+    match meta.expected_env_version with
+    | None -> V1
+    | Some v -> v in
+  let protocol = { expected_env ; components } in
+  let hash =
+    match meta.hash with
+    | None -> hash protocol
+    | Some hash -> hash in
+  hash, protocol
+
+open Lwt.Infix
+
+let create_files dir units =
+  Lwt_utils.remove_dir dir >>= fun () ->
+  Lwt_utils.create_dir dir >>= fun () ->
+  Lwt_list.map_s
+    (fun { name ; interface ; implementation } ->
+       let name = String.lowercase_ascii name in
+       let ml = dir // (name ^ ".ml") in
+       let mli = dir // (name ^ ".mli") in
+       Lwt_utils.create_file ml implementation >>= fun () ->
+       match interface with
+       | None -> Lwt.return [ml]
+       | Some content ->
+           Lwt_utils.create_file mli content >>= fun () ->
+           Lwt.return [ mli ; ml ])
+    units >>= fun files ->
+  let files = List.concat files in
+  Lwt.return files
+
+let write_dir dir ?hash (p: t) =
+  create_files dir p.components >>= fun _files ->
+  Meta.to_file
+    ~dir
+    ?hash
+    ~env_version:p.expected_env
+    (List.map (fun { name ; _ } -> String.capitalize_ascii name) p.components) ;
+  Lwt.return_unit
+

lib_base/protocol.mli

@@ -27,3 +27,17 @@ include S.HASHABLE with type t := t
                     and type hash := Protocol_hash.t
 val of_bytes_exn: MBytes.t -> t
 
+module Meta: sig
+
+  type t = {
+    hash: Protocol_hash.t option ;
+    expected_env_version: env_version option ;
+    modules: string list ;
+  }
+
+  val encoding: t Data_encoding.t
+
+end
+
+val read_dir: string -> Protocol_hash.t * t
+val write_dir: string -> ?hash:Protocol_hash.t -> t -> unit Lwt.t

lib_client_base/client_protocols.ml

@@ -38,7 +38,7 @@ let commands () =
       (fun () dirname (cctxt : Client_commands.full_context) ->
          Lwt.catch
            (fun () ->
-              let _hash, proto = Tezos_protocol_compiler.Native.read_dir dirname in
+              let _hash, proto = Protocol.read_dir dirname in
               Client_node_rpcs.inject_protocol cctxt proto >>= function
               | Ok hash ->
                   cctxt#message "Injected protocol %a successfully" Protocol_hash.pp_short hash >>= fun () ->
@@ -60,7 +60,7 @@ let commands () =
        @@ stop)
       (fun () ph (cctxt : Client_commands.full_context) ->
          Client_node_rpcs.Protocols.contents cctxt ph >>=? fun proto ->
-         Updater.extract (Protocol_hash.to_short_b58check ph) ~hash:ph proto >>= fun () ->
+         Protocol.write_dir (Protocol_hash.to_short_b58check ph) ~hash:ph proto >>= fun () ->
          cctxt#message "Extracted protocol %a" Protocol_hash.pp_short ph >>= fun () ->
          return ()
       ) ;

lib_node_updater/updater.ml

@@ -44,46 +44,17 @@ let get_datadir () =
 let init dir =
   datadir := Some dir
 
-let create_files dir units =
-  Lwt_utils.remove_dir dir >>= fun () ->
-  Lwt_utils.create_dir dir >>= fun () ->
-  Lwt_list.map_s
-    (fun { Protocol.name; interface; implementation } ->
-       let name = String.lowercase_ascii name in
-       let ml = dir // (name ^ ".ml") in
-       let mli = dir // (name ^ ".mli") in
-       Lwt_utils.create_file ml implementation >>= fun () ->
-       match interface with
-       | None -> Lwt.return [ml]
-       | Some content ->
-           Lwt_utils.create_file mli content >>= fun () ->
-           Lwt.return [mli;ml])
-    units >>= fun files ->
-  let files = List.concat files in
-  Lwt.return files
-
-let extract dir ?hash (p: Protocol.t) =
-  create_files dir p.components >>= fun _files ->
-  Tezos_protocol_compiler.Native.Meta.to_file dir
-    ?hash
-    ~env_version:p.expected_env
-    (List.map (fun {Protocol.name} -> String.capitalize_ascii name) p.components) ;
-  Lwt.return_unit
-
 let compiler_name = "tezos-protocol-compiler"
 
 let do_compile hash p =
   assert (p.Protocol.expected_env = V1) ;
-  let units = p.components in
   let datadir = get_datadir () in
   let source_dir = datadir // Protocol_hash.to_short_b58check hash // "src" in
   let log_file = datadir // Protocol_hash.to_short_b58check hash // "LOG" in
   let plugin_file = datadir // Protocol_hash.to_short_b58check hash //
                     Format.asprintf "protocol_%a.cmxs" Protocol_hash.pp hash
   in
-  create_files source_dir units >>= fun _files ->
+  Protocol.write_dir source_dir ~hash p >>= fun () ->
-  Tezos_protocol_compiler.Native.Meta.to_file source_dir ~hash
-    (List.map (fun {Protocol.name} -> String.capitalize_ascii name) units);
   let compiler_command =
     (Sys.executable_name,
      Array.of_list [compiler_name; plugin_file; source_dir]) in

lib_node_updater/updater.mli

@@ -14,7 +14,6 @@ val activate: Context.t -> Protocol_hash.t -> Context.t Lwt.t
 val fork_test_network:
   Context.t -> protocol:Protocol_hash.t -> expiration:Time.t -> Context.t Lwt.t
 
-val extract: Lwt_io.file_name -> ?hash:Protocol_hash.t -> Protocol.t -> unit Lwt.t
 val init: string -> unit
 
 type validation_result = {

lib_protocol_compiler/native.ml

@@ -188,64 +188,6 @@ let compile_ml ?for_pack ml =
   Clflags.for_package := None ;
   target ^ ".cmx"
 
-module Meta = struct
-
-  let name = "TEZOS_PROTOCOL"
-
-  let config_file_encoding =
-    let open Data_encoding in
-    obj3
-      (opt "hash"
-         ~description:"Used to force the hash of the protocol"
-         Protocol_hash.encoding)
-      (opt "expected_env_version"
-         Protocol.env_version_encoding)
-      (req "modules"
-         ~description:"Modules comprising the protocol"
-         (list string))
-
-  let to_file dirname ?hash ?env_version modules =
-    let config_file =
-      Data_encoding.Json.construct
-        config_file_encoding
-        (hash, env_version, modules) in
-    Utils.write_file ~bin:false (dirname // name) @@
-    Data_encoding_ezjsonm.to_string config_file
-
-  let of_file dirname =
-    Utils.read_file ~bin:false (dirname // name) |>
-    Data_encoding_ezjsonm.from_string |> function
-    | Error err -> Pervasives.failwith err
-    | Ok json -> Data_encoding.Json.destruct config_file_encoding json
-
-end
-
-let find_component dirname module_name =
-  let open Protocol in
-  let name_lowercase = String.uncapitalize_ascii module_name in
-  let implementation = dirname // name_lowercase ^ ".ml" in
-  let interface = implementation ^ "i" in
-  match Sys.file_exists implementation, Sys.file_exists interface with
-  | false, _ -> Pervasives.failwith @@ "Not such file: " ^ implementation
-  | true, false ->
-      let implementation = Utils.read_file ~bin:false implementation in
-      { name = module_name; interface = None; implementation }
-  | _ ->
-      let interface = Utils.read_file ~bin:false interface in
-      let implementation = Utils.read_file ~bin:false implementation in
-      { name = module_name; interface = Some interface; implementation }
-
-let read_dir dirname =
-  let hash, expected_env, modules = Meta.of_file dirname in
-  let components = List.map (find_component dirname) modules in
-  let expected_env = match expected_env with None -> Protocol.V1 | Some v -> v in
-  let protocol = Protocol.{ expected_env ; components } in
-  let hash =
-    match hash with
-    | None -> Protocol.hash protocol
-    | Some hash -> hash in
-  hash, protocol
-
 (** Main *)
 
 let mktemp_dir () =
@@ -282,7 +224,7 @@ let main () =
     | Some dir -> dir in
   Lwt_main.run (Lwt_utils.create_dir ~perm:0o755 build_dir) ;
   Lwt_main.run (Lwt_utils.create_dir ~perm:0o755 (Filename.dirname output)) ;
-  let hash, protocol = read_dir source_dir in
+  let hash, protocol = Protocol.read_dir source_dir in
   (* Generate the 'functor' *)
   let functor_file = build_dir // "functor.ml" in
   let oc = open_out functor_file in

lib_protocol_compiler/native.mli

@@ -9,17 +9,4 @@
 
 (** Low-level part of the [Updater]. *)
 
-module Meta : sig
-  val to_file:
-    Lwt_io.file_name ->
-    ?hash:Protocol_hash.t ->
-    ?env_version:Protocol.env_version ->
-    string list -> unit
-  val of_file:
-    Lwt_io.file_name ->
-    Protocol_hash.t option * Protocol.env_version option * string list
-end
-
-val read_dir: Lwt_io.file_name -> Protocol_hash.t * Protocol.t
-
 val main: unit -> unit