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

tezos_compiler: changes

Browse Source 
* Read TEZOS_PROTOCOL in json format
* Define Protocol module here
* Fix dependent modules to use Protocol defined here
* Compute hash of protocol if absent in TEZOS_PROTOCOL
This commit is contained in:
Vincent Bernardoff 2016-10-24 19:15:35 +02:00
parent ccf6ed4a9d
commit 0af5f6e7c3
9 changed files with 87 additions and 89 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

87
src/compiler/tezos_compiler.ml
View File

@ -104,48 +104,48 @@ let unlink_object obj =
(** TEZOS_PROTOCOL files *)
module Meta = struct
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));
module Protocol = struct
type component = {
name: string;
interface: string option;
implementation: string;
}
class protocol_hash_cp =
[Protocol_hash.t] Config_file.cp_custom_type hash_wrapper
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))
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
type t = component list
let encoding = Data_encoding.list component_encoding
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_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 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))

20
src/compiler/tezos_compiler.mli
View File

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

30
src/node/db/store.ml
View File

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

19
src/node/db/store.mli
View File

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

4
src/node/shell/node_rpc_services.ml
View File

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

2
src/node/shell/state.ml
View File

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

4
src/node/shell/state.mli
View File

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

4
src/node/updater/updater.ml
View File

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

2
src/node/updater/updater.mli
View File

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