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

Client refactor: move stdlib_lwt out of base

Browse Source
This commit is contained in:
Grégoire Henry 2018-02-08 10:51:01 +01:00
parent 84d8ae9222
commit 484b5b5b08
18 changed files with 139 additions and 110 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/bin_node/jbuild
View File

@ -4,6 +4,7 @@
((name main)
(public_name tezos-node)
(libraries (tezos-base
tezos-stdlib-lwt
tezos-shell-services
tezos-rpc-http
tezos-p2p
@ -17,6 +18,7 @@
(flags (:standard -w -9+27-30-32-40@8
-safe-string
-open Tezos_base__TzPervasives
-open Tezos_stdlib_lwt
-open Tezos_shell_services
-open Tezos_rpc_http
-open Tezos_p2p

6
src/lib_base/jbuild
View File

@ -5,7 +5,6 @@
(public_name tezos-base)
(flags (:standard -w -30
-open Tezos_stdlib
-open Tezos_stdlib_lwt
-open Tezos_crypto
-open Tezos_data_encoding
-open Tezos_error_monad
@ -13,7 +12,6 @@
-open Tezos_micheline
-safe-string))
(libraries (tezos-stdlib
tezos-stdlib-lwt
tezos-crypto
tezos-data-encoding
tezos-error-monad
@ -21,7 +19,9 @@
tezos-micheline
calendar
ezjsonm
mtime.clock.os))))
lwt.unix
mtime.clock.os
ipaddr.unix))))
(alias
((name runtest_indent)

76
src/lib_base/protocol.ml
View File

@ -7,8 +7,6 @@
(* *)
(**************************************************************************)
let (//) = Filename.concat
type t = {
expected_env: env_version ;
components: component list ;
@ -102,8 +100,6 @@ module Meta = struct
modules: string list ;
}
let name = "TEZOS_PROTOCOL"
let encoding =
let open Data_encoding in
conv
@ -121,76 +117,4 @@ module Meta = struct
~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.Json.to_string config_file
let of_file ~dir:dirname =
Utils.read_file ~bin:false (dirname // name) |>
Data_encoding.Json.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_unix.remove_dir dir >>= fun () ->
Lwt_utils_unix.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_unix.create_file ml implementation >>= fun () ->
match interface with
| None -> Lwt.return [ml]
| Some content ->
Lwt_utils_unix.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

3
src/lib_base/protocol.mli
View File

@ -40,6 +40,3 @@ module Meta: sig
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

3
src/lib_base/tezos-base.opam
View File

@ -16,8 +16,9 @@ depends: [
"tezos-error-monad"
"tezos-micheline"
"tezos-rpc"
"ezjsonm" { >= "0.5.0" }
"calendar"
"ezjsonm" { >= "0.5.0" }
"ipaddr"
"mtime" { >= "1.0.0" }
]
build: [

1
src/lib_base/tzPervasives.ml
View File

@ -8,7 +8,6 @@
(**************************************************************************)
include Tezos_stdlib
include Tezos_stdlib_lwt
include Tezos_data_encoding
include Tezos_error_monad
include Tezos_rpc

4
src/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 = Protocol.read_dir dirname in
Lwt_utils_unix.Protocol.read_dir dirname >>=? fun (_hash, proto) ->
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 ->
Protocol.write_dir (Protocol_hash.to_short_b58check ph) ~hash:ph proto >>= fun () ->
Lwt_utils_unix.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 ()
) ;

2
src/lib_client_base/jbuild
View File

@ -4,12 +4,14 @@
((name tezos_client_base)
(public_name tezos-client-base)
(libraries (tezos-base
tezos-stdlib-lwt
tezos-shell-services
tezos-rpc-http))
(library_flags (:standard -linkall))
(flags (:standard -w -9+27-30-32-40@8
-safe-string
-open Tezos_base__TzPervasives
-open Tezos_stdlib_lwt
-open Tezos_rpc_http
-open Tezos_shell_services))))

6
src/lib_p2p/jbuild
View File

@ -3,10 +3,12 @@
(library
((name tezos_p2p)
(public_name tezos-p2p)
(libraries (tezos-base))
(libraries (tezos-base
tezos-stdlib-lwt))
(flags (:standard -w -9+27-30-32-40@8
-safe-string
-open Tezos_base__TzPervasives))))
-open Tezos_base__TzPervasives
-open Tezos_stdlib_lwt))))
(alias
((name runtest_indent)

2
src/lib_p2p/test/jbuild
View File

@ -5,12 +5,14 @@
test_p2p_pool
test_p2p_io_scheduler))
(libraries (tezos-base
tezos-stdlib-lwt
tezos-p2p
tezos-test-helpers))
(flags (:standard -w -9-32
-linkall
-safe-string
-open Tezos_base__TzPervasives
-open Tezos_stdlib_lwt
-open Tezos_test_helpers
-open Tezos_p2p))))

7
src/lib_protocol_compiler/compiler.ml
View File

@ -177,7 +177,12 @@ let main { compile_ml ; pack_objects ; link_shared } =
at_exit (fun () -> Lwt_main.run (Lwt_utils_unix.remove_dir dir)) ;
dir
| Some dir -> dir in
let hash, protocol = Protocol.read_dir source_dir in
let hash, protocol =
match Lwt_main.run (Lwt_utils_unix.Protocol.read_dir source_dir) with
| Ok v -> v
| Error err ->
Format.kasprintf Pervasives.failwith
"Failed to read TEZOS_PROTOCOL: %a" pp_print_error err in
Lwt_main.run (Lwt_utils_unix.create_dir ~perm:0o755 build_dir) ;
Lwt_main.run (Lwt_utils_unix.create_dir ~perm:0o755 (Filename.dirname output)) ;
(* Generate the 'functor' *)

10
src/lib_protocol_compiler/jbuild
View File

@ -25,6 +25,7 @@
(public_name tezos-protocol-compiler)
(libraries (tezos-base
tezos-protocol-environment-sigs
tezos-stdlib-lwt
compiler-libs
lwt.unix
ocplib-endian
@ -32,7 +33,8 @@
unix))
(flags (:standard -w -9+27-30-32-40@8
-safe-string
-open Tezos_base__TzPervasives))
-open Tezos_base__TzPervasives
-open Tezos_stdlib_lwt))
(modules (Embedded_cmis Packer Compiler))))
(library
@ -79,9 +81,11 @@
((name main_embedded_packer)
(public_name tezos-embedded-protocol-packer)
(modes (native))
(libraries (tezos-base))
(libraries (tezos-base
tezos-stdlib-lwt))
(flags (:standard -linkall
-open Tezos_base__TzPervasives))
-open Tezos_base__TzPervasives
-open Tezos_stdlib_lwt))
(modules (Main_embedded_packer))))
(install

7
src/lib_protocol_compiler/main_embedded_packer.ml
View File

@ -10,7 +10,12 @@
let srcdir = Sys.argv.(1)
let version = Sys.argv.(2)
let hash, sources = Protocol.read_dir srcdir
let hash, sources =
match Lwt_main.run (Lwt_utils_unix.Protocol.read_dir srcdir) with
| Ok v -> v
| Error err ->
Format.kasprintf Pervasives.failwith
"Failed to read TEZOS_PROTOCOL: %a" pp_print_error err
let () =
Format.printf {|

2
src/lib_protocol_updater/jbuild
View File

@ -4,6 +4,7 @@
((name tezos_protocol_updater)
(public_name tezos-protocol-updater)
(libraries (tezos-base
tezos-stdlib-lwt
tezos-micheline
tezos-protocol-compiler.registerer
tezos-protocol-compiler.native
@ -12,6 +13,7 @@
(flags (:standard -w -9+27-30-32-40@8
-safe-string
-open Tezos_base__TzPervasives
-open Tezos_stdlib_lwt
-open Tezos_micheline
-open Tezos_storage))))

25
src/lib_protocol_updater/updater.ml
View File

@ -60,23 +60,26 @@ module Raw = struct
let plugin_file = datadir // Protocol_hash.to_short_b58check hash //
Format.asprintf "protocol_%a.cmxs" Protocol_hash.pp hash
in
Protocol.write_dir source_dir ~hash p >>= fun () ->
let compiler_command =
(Sys.executable_name,
Array.of_list [compiler_name; "-register"; plugin_file; source_dir]) in
let fd = Unix.(openfile log_file [O_WRONLY; O_CREAT; O_TRUNC] 0o644) in
let pi =
begin
Lwt_utils_unix.Protocol.write_dir source_dir ~hash p >>=? fun () ->
let compiler_command =
(Sys.executable_name,
Array.of_list [compiler_name; "-register"; plugin_file; source_dir]) in
let fd = Unix.(openfile log_file [O_WRONLY; O_CREAT; O_TRUNC] 0o644) in
Lwt_process.exec
~stdin:`Close ~stdout:(`FD_copy fd) ~stderr:(`FD_move fd)
compiler_command in
pi >>= function
| Unix.WSIGNALED _ | Unix.WSTOPPED _ ->
compiler_command >>= return
end >>= function
| Error err ->
log_error "Error %a" pp_print_error err ;
Lwt.return false
| Ok (Unix.WSIGNALED _ | Unix.WSTOPPED _) ->
log_error "INTERRUPTED COMPILATION (%s)" log_file;
Lwt.return false
| Unix.WEXITED x when x <> 0 ->
| Ok (Unix.WEXITED x) when x <> 0 ->
log_error "COMPILATION ERROR (%s)" log_file;
Lwt.return false
| Unix.WEXITED _ ->
| Ok (Unix.WEXITED _) ->
try Dynlink.loadfile_private plugin_file; Lwt.return true
with Dynlink.Error err ->
log_error "Can't load plugin: %s (%s)"

8
src/lib_stdlib_lwt/jbuild
View File

@ -4,13 +4,9 @@
((name tezos_stdlib_lwt)
(public_name tezos-stdlib-lwt)
(flags (:standard -w -9-30
-open Tezos_stdlib
-open Tezos_data_encoding
-open Tezos_error_monad
-open Tezos_base__TzPervasives
-safe-string))
(libraries (tezos-stdlib
tezos-data-encoding
tezos-error-monad
(libraries (tezos-base
lwt.unix
ipaddr.unix
str))))

77
src/lib_stdlib_lwt/lwt_utils_unix.ml
View File

@ -145,3 +145,80 @@ module Json = struct
end
end
module Protocol = struct
let name = "TEZOS_PROTOCOL"
open Protocol
let (//) = Filename.concat
let to_file ~dir:dirname ?hash ?env_version modules =
let config_file =
Data_encoding.Json.construct
Meta.encoding
{ hash ; expected_env_version = env_version ; modules } in
Json.write_file (dirname // name) config_file
let of_file ~dir:dirname =
Json.read_file (dirname // name) >>=? fun json ->
return (Data_encoding.Json.destruct Meta.encoding json)
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 =
of_file ~dir >>=? fun meta ->
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
return (hash, protocol)
open Lwt.Infix
let create_files dir units =
remove_dir dir >>= fun () ->
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
create_file ml implementation >>= fun () ->
match interface with
| None -> Lwt.return [ml]
| Some content ->
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 ->
to_file
~dir
?hash
~env_version:p.expected_env
(List.map (fun { name ; _ } -> String.capitalize_ascii name) p.components)
end

8
src/lib_stdlib_lwt/lwt_utils_unix.mli
View File

@ -40,3 +40,11 @@ module Json : sig
val write_file : string -> Data_encoding.json -> unit tzresult Lwt.t
end
module Protocol : sig
val read_dir: string -> (Protocol_hash.t * Protocol.t) tzresult Lwt.t
val write_dir: string -> ?hash:Protocol_hash.t -> Protocol.t -> unit tzresult Lwt.t
end