diff --git a/src/compiler/tezos_compiler.ml b/src/compiler/tezos_compiler.ml index 4b533f6e0..cb8b99d01 100644 --- a/src/compiler/tezos_compiler.ml +++ b/src/compiler/tezos_compiler.ml @@ -104,48 +104,48 @@ let unlink_object obj = (** TEZOS_PROTOCOL files *) +module Protocol = struct + type component = { + name: string; + interface: string option; + implementation: string; + } + + let component_encoding = + let open Data_encoding in + conv + (fun { name ; interface; implementation } -> (name, interface, implementation)) + (fun (name, interface, implementation) -> { name ; interface ; implementation }) + (obj3 + (req "name" string) + (opt "interface" string) + (req "implementation" string)) + + type t = component list + let encoding = Data_encoding.list component_encoding + + let to_bytes v = Data_encoding.Binary.to_bytes encoding v + let of_bytes b = Data_encoding.Binary.of_bytes encoding b + let hash proto = Protocol_hash.hash_bytes [to_bytes proto] +end + module Meta = struct + let config_file_encoding = + let open Data_encoding in + obj2 + (opt "hash" ~description:"Used to force the hash of the protocol" Protocol_hash.encoding) + (req "modules" ~description:"Modules comprising the protocol" (list string)) - let hash_wrapper = - let open Config_file in - { to_raw = (fun h -> Raw.String (Protocol_hash.to_b48check h)); - of_raw = (function - | Raw.String h -> begin try - Protocol_hash.of_b48check h - with _ -> - let error oc = Printf.fprintf oc "Invalid Base48Check-encoded SHA256 key %S" h in - raise (Wrong_type error) - end - | _ -> - let error oc = - Printf.fprintf oc "Unexcepted value: should be a Base48Check-encoded SHA256 key." in - raise (Wrong_type error)); - } - - class protocol_hash_cp = - [Protocol_hash.t] Config_file.cp_custom_type hash_wrapper - - let to_file file hash modules = - let group = new Config_file.group in - let _ = new protocol_hash_cp ~group ["hash"] hash "" in - let _ = - new Config_file.list_cp Config_file.string_wrappers ~group - ["modules"] modules "" in - group#write file - - let of_file file = - let group = new Config_file.group in - let hash = - new protocol_hash_cp ~group ["hash"] - (Protocol_hash.of_b48check - "TnrnfGHMCPAcxtMAHXdpfebbnn2XvPAxq7DHbpeJbKTkJQPgcgRGr") - "" in - let modules = - new Config_file.list_cp Config_file.string_wrappers ~group - ["modules"] [] "" in - group#read file; - (hash#get, modules#get) + let to_file fn ?hash modules = + let open Data_encoding.Json in + let config_file = construct config_file_encoding (hash, modules) in + Utils.write_file ~bin:false fn @@ to_string config_file + let of_file fn = + let open Data_encoding.Json in + Utils.read_file ~bin:false fn |> from_string |> function + | Error err -> Pervasives.failwith err + | Ok json -> destruct config_file_encoding json end (** Semi-generic compilation functions *) @@ -269,6 +269,15 @@ let mktemp_dir () = Filename.get_temp_dir_name () // Printf.sprintf "tezos-protocol-build-%06X" (Random.int 0xFFFFFF) +let create_component dirname name = + let name_lowercase = String.uncapitalize_ascii 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 ("No such file " ^ implementation) + | true, false -> { Protocol.name; interface = None; implementation } + | _ -> { name; interface = Some interface; implementation } + let main () = Random.self_init () ; @@ -310,6 +319,10 @@ let main () = if not keep_object then Unix.rmdir build_dir ) ; let hash, units = Meta.of_file (source_dir // "TEZOS_PROTOCOL") in + let hash = match hash with + | Some hash -> hash + | None -> Protocol.hash @@ List.map (create_component source_dir) units + in let packname = if keep_object then String.capitalize_ascii (Filename.(basename @@ chop_extension output)) diff --git a/src/compiler/tezos_compiler.mli b/src/compiler/tezos_compiler.mli index e2548ac2f..1dd2703aa 100644 --- a/src/compiler/tezos_compiler.mli +++ b/src/compiler/tezos_compiler.mli @@ -9,11 +9,23 @@ (** Low-level part of the [Updater]. *) +module Protocol : sig + type component = { + name : string; + interface : string option; + implementation : string; + } + val component_encoding : component Data_encoding.encoding + type t = component list + val encoding : component list Data_encoding.encoding + val to_bytes : component list -> MBytes.t + val of_bytes : MBytes.t -> component list option + val hash : component list -> Hash.Protocol_hash.t +end + module Meta : sig - - val to_file: string -> Protocol_hash.t -> string list -> unit - val of_file: string -> Protocol_hash.t * string list - + val to_file: string -> ?hash:Protocol_hash.t -> string list -> unit + val of_file: string -> Protocol_hash.t option * string list end val main: unit -> unit diff --git a/src/node/db/store.ml b/src/node/db/store.ml index 2447b001a..3673ecb6f 100644 --- a/src/node/db/store.ml +++ b/src/node/db/store.ml @@ -508,30 +508,10 @@ end (*-- Typed operation store under "protocols/" -------------------------------*) -type component = { - name : string ; - interface : string option ; - implementation : string ; -} +type protocol = Tezos_compiler.Protocol.t +let protocol_encoding = Tezos_compiler.Protocol.encoding -let component_encoding = - let open Data_encoding in - conv - (fun { name ; interface; implementation } -> (name, interface, implementation)) - (fun (name, interface, implementation) -> { name ; interface ; implementation }) - (obj3 - (req "name" string) - (opt "interface" string) - (req "implementation" string)) - -type protocol = component list -let protocol_encoding = Data_encoding.list component_encoding - -module Raw_protocol_value = struct - type t = protocol - let to_bytes v = Data_encoding.Binary.to_bytes protocol_encoding v - let of_bytes b = Data_encoding.Binary.of_bytes protocol_encoding b -end +module Raw_protocol_value = Tezos_compiler.Protocol module Raw_protocol_key = struct type t = Protocol_hash.t @@ -556,7 +536,7 @@ module Protocol_errors = Make (Protocol_errors_key) (Errors_value) module Protocol = struct type t = FS.t type key = Protocol_hash.t - type value = protocol tzresult Time.timed_data + type value = Tezos_compiler.Protocol.t tzresult Time.timed_data let mem = Protocol_data.mem let get s k = Protocol_time.get s k >>= function @@ -587,7 +567,7 @@ module Protocol = struct Protocol_errors.del s k let of_bytes = Raw_protocol_value.of_bytes let to_bytes = Raw_protocol_value.to_bytes - let hash proto = Protocol_hash.hash_bytes [to_bytes proto] + let hash = Raw_protocol_value.hash let compare p1 p2 = Protocol_hash.(compare (hash_bytes [to_bytes p1]) (hash_bytes [to_bytes p2])) let equal b1 b2 = compare b1 b2 = 0 diff --git a/src/node/db/store.mli b/src/node/db/store.mli index 8bbc1ebf7..6a311bf43 100644 --- a/src/node/db/store.mli +++ b/src/node/db/store.mli @@ -113,15 +113,8 @@ type block = { val shell_block_encoding: shell_block Data_encoding.t val block_encoding: block Data_encoding.t -(** Protocol *) -type component = { - name : string ; - interface : string option ; - implementation : string ; -} - -type protocol = component list -val protocol_encoding : protocol Data_encoding.t +type protocol = Tezos_compiler.Protocol.t +val protocol_encoding: protocol Data_encoding.t (** {2 Block and operations store} ********************************************) @@ -194,14 +187,14 @@ module Operation : sig end module Protocol : sig - val of_bytes: MBytes.t -> protocol option - val to_bytes: protocol -> MBytes.t - val hash: protocol -> Protocol_hash.t + val of_bytes: MBytes.t -> Tezos_compiler.Protocol.t option + val to_bytes: Tezos_compiler.Protocol.t -> MBytes.t + val hash: Tezos_compiler.Protocol.t -> Protocol_hash.t include TYPED_IMPERATIVE_STORE with type t = protocol_store and type key = Protocol_hash.t - and type value = protocol tzresult Time.timed_data + and type value = Tezos_compiler.Protocol.t tzresult Time.timed_data val raw_get: t -> Protocol_hash.t -> MBytes.t option Lwt.t end diff --git a/src/node/shell/node_rpc_services.ml b/src/node/shell/node_rpc_services.ml index 4b85cd97e..b4d3332e4 100644 --- a/src/node/shell/node_rpc_services.ml +++ b/src/node/shell/node_rpc_services.ml @@ -548,10 +548,10 @@ let inject_protocol = in let proto_of_rpc = List.map (fun (name, interface, implementation) -> - { Store.name; interface; implementation }) + { Tezos_compiler.Protocol.name; interface; implementation }) in let rpc_of_proto = - List.map (fun { Store.name; interface; implementation } -> + List.map (fun { Tezos_compiler.Protocol.name; interface; implementation } -> (name, interface, implementation)) in RPC.service diff --git a/src/node/shell/state.ml b/src/node/shell/state.ml index 3fb1853dd..2a11aa2a2 100644 --- a/src/node/shell/state.ml +++ b/src/node/shell/state.ml @@ -251,7 +251,7 @@ end module Protocol = struct type key = Store.Protocol.key - type component = Store.component = { + type component = Tezos_compiler.Protocol.component = { name: string; interface: string option; implementation: string diff --git a/src/node/shell/state.mli b/src/node/shell/state.mli index 7ea0dfdda..39b282737 100644 --- a/src/node/shell/state.mli +++ b/src/node/shell/state.mli @@ -350,13 +350,13 @@ module Protocol : sig type key = Protocol_hash.t - type component = Store.component = { + type component = Tezos_compiler.Protocol.component = { name : string ; interface : string option ; implementation : string ; } - type t = Store.protocol + type t = Tezos_compiler.Protocol.t type protocol = t diff --git a/src/node/updater/updater.ml b/src/node/updater/updater.ml index 32a5971fd..865323b54 100644 --- a/src/node/updater/updater.ml +++ b/src/node/updater/updater.ml @@ -131,7 +131,7 @@ let get_basedir () = let init dir = basedir := Some dir -type component = Store.component = { +type component = Tezos_compiler.Protocol.component = { name : string ; interface : string option ; implementation : string ; @@ -164,7 +164,7 @@ let do_compile hash units = create_files source_dir units >>= fun _files -> Tezos_compiler.Meta.to_file (source_dir // "TEZOS") - hash + ~hash (List.map (fun {name} -> String.capitalize_ascii name) units); let compiler_command = (Sys.executable_name, diff --git a/src/node/updater/updater.mli b/src/node/updater/updater.mli index e82447228..1afa0ae4b 100644 --- a/src/node/updater/updater.mli +++ b/src/node/updater/updater.mli @@ -70,7 +70,7 @@ module type REGISTRED_PROTOCOL = sig and type 'a tzresult := 'a tzresult end -type component = Store.component = { +type component = Tezos_compiler.Protocol.component = { name : string ; interface : string option ; implementation : string ;