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

Base: move Protocol.Meta from lib_protocol_compiler to lib_base

Browse Source
This commit is contained in:
Grégoire Henry 2017-12-05 15:15:38 +01:00 committed by Benjamin Canou
parent a505b54287
commit da87aaadc5
7 changed files with 121 additions and 105 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

103
lib_base/protocol.ml
View File

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

14
lib_base/protocol.mli
View File

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

4
lib_client_base/client_protocols.ml
View File

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

31
lib_node_updater/updater.ml
View File

@ -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 ->
Tezos_protocol_compiler.Native.Meta.to_file source_dir ~hash
(List.map (fun {Protocol.name} -> String.capitalize_ascii name) units);
Protocol.write_dir source_dir ~hash p >>= fun () ->
let compiler_command =
(Sys.executable_name,
Array.of_list [compiler_name; plugin_file; source_dir]) in

1
lib_node_updater/updater.mli
View File

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

60
lib_protocol_compiler/native.ml
View File

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

13
lib_protocol_compiler/native.mli
View File

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