Skip to content

Commit

Permalink
Fetch external libraries from Zilliqa
Browse files Browse the repository at this point in the history
  • Loading branch information
saeed-zil committed Nov 6, 2024
1 parent de22052 commit 810578f
Show file tree
Hide file tree
Showing 17 changed files with 151 additions and 49 deletions.
18 changes: 11 additions & 7 deletions src/base/Checker.ml
Original file line number Diff line number Diff line change
Expand Up @@ -243,8 +243,7 @@ let check_lmodule cli =
~default:(None, [])
in
(* this_address is mandatory *)
let this_address = Option.value_exn this_address_opt
in
let this_address = Option.value_exn this_address_opt in
let elibs = import_libs lmod.elibs init_address_map in
let%bind dis_lmod =
wrap_error_with_gas initial_gas
Expand Down Expand Up @@ -315,8 +314,7 @@ let check_cmodule cli =
~default:(None, [])
in
(* this_address is mandatory *)
let this_address = Option.value_exn this_address_opt
in
let this_address = Option.value_exn this_address_opt in
let elibs = import_libs cmod.elibs init_address_map in
let%bind dis_cmod =
wrap_error_with_gas initial_gas
Expand All @@ -342,7 +340,7 @@ let check_cmodule cli =
CG.dump_callgraph stdout cg;
exit 0)
else if cli.dump_callgraph then
let out = Out_channel.create ("callgraph.dot") ~binary:true in
let out = Out_channel.create "callgraph.dot" ~binary:true in
CG.dump_callgraph out cg);
let%bind () =
if cli.disable_analy_warn then pure ()
Expand Down Expand Up @@ -429,6 +427,13 @@ let init_checker args ~exe_name =
StdlibTracker.add_stdlib_dirs cli.stdlib_dirs;
(* Get list of stdlib dirs. *)
let lib_dirs = StdlibTracker.get_stdlib_dirs () in
let is_ipc = not @@ String.is_empty cli.ipc_address in
(if is_ipc then
let open StateService in
let open MonadUtil in
let open Result.Let_syntax in
let sm = IPC cli.ipc_address in
initialize ~sm ~fields:[] ~ext_states:[] ~bcinfo:(Caml.Hashtbl.create 0));
if List.is_empty lib_dirs then stdlib_not_found_err ~exe_name ();
cli

Expand All @@ -442,6 +447,5 @@ let run args ~exe_name =
if cli.is_library then
(* Check library modules. *)
check_lmodule cli |> fun (out, _) -> out
else
(* Check contract modules. *)
else (* Check contract modules. *)
check_cmodule cli |> fun (out, _) -> out
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
74 changes: 61 additions & 13 deletions src/base/RunnerUtil.ml
Original file line number Diff line number Diff line change
Expand Up @@ -77,20 +77,54 @@ let get_init_this_address_and_extlibs_string str =
then
fatal_error
@@ mk_error0 ~kind:"Duplicate extlib map entries in init JSON file"
~inst:str
~inst:str
else (this_address, name_addr_pairs)
with Invalid_json s ->
fatal_error
(s @ mk_error0 ~kind:"Unable to parse JSON file" ~inst:str)
fatal_error (s @ mk_error0 ~kind:"Unable to parse JSON file" ~inst:str)

module CULiteral = GlobalLiteral
module CUType = CULiteral.LType
module CUIdentifier = CUType.TIdentifier
module CUName = CUIdentifier.Name
open Result.Let_syntax
open MonadUtil

let label_name_of_string str = CUName.parse_simple_name str
let code_label = label_name_of_string "_code"
let fromR r = match r with Error s -> fail s | Core.Ok a -> pure a

let fetch_code ~caddr =
let this_id = CUIdentifier.mk_loc_id code_label in
let%bind fval, _ =
fromR
@@ StateService.external_fetch ~caddr ~fname:this_id ~keys:[]
~ignoreval:false
in
match fval with Some code -> pure code | None -> failwith "Code not found"

(* Checks that _this_address is defined *)
(* Find (by looking for in StdlibTracker) and parse library named "id.scillib".
* If "id.json" exists, parse it's extlibs info and provide that also. *)
let import_lib name sloc =
let fname, this_address, initf =
print_endline ("Import lib: " ^ name);
let caddr =
if String.is_prefix name ~prefix:"0x" then
GlobalLiteral.Bystrx.parse_hex name
else GlobalLiteral.Bystrx.parse_hex "0x00000000"
in

let isFile, fname, this_address, initf =
match StdlibTracker.find_lib_dir name with
| None ->
let errmsg = sprintf "Failed to import library (not found)" in
fatal_error @@ mk_error1 ~kind:errmsg ~inst:name sloc
| None -> (
match fetch_code ~caddr with
| Ok v -> (
match v with
| Literal.GlobalLiteral.StringLit x -> (false, x, name, [])
| _ -> failwith "khar")
| Error e ->
print_endline ("FAILED #1" ^ sprint_scilla_error_list e);
let errmsg = sprintf "Failed to import library (not found)" in
fatal_error @@ mk_error1 ~kind:errmsg ~inst:name sloc)
| Some d ->
let libf = d ^/ name ^. StdlibTracker.file_extn_library in
let initf = d ^/ name ^. "json" in
Expand All @@ -99,12 +133,19 @@ let import_lib name sloc =
in
(* If this_address is unspecified in the init file, then use the base filename without extension as the address *)
let this_address = Option.value init_this_address ~default:name in
(libf, this_address, extlibs)
(true, libf, this_address, extlibs)
in
match RULocalFEParser.parse_file RULocalParser.Incremental.lmodule fname with
print_endline
(" imported: " ^ (if isFile then "FILE " else "STRING ") ^ fname);
match
if isFile then
RULocalFEParser.parse_file RULocalParser.Incremental.lmodule fname
else RULocalFEParser.parse_string RULocalParser.Incremental.lmodule fname
with
| Error s ->
fatal_error (s @ (mk_error1 ~kind:"Failed to parse" ?inst:None) sloc)
| Ok lmod ->
print_endline (sprintf "Successfully imported external library %s\n" name);
plog (sprintf "Successfully imported external library %s\n" name);
(lmod, this_address, initf)

Expand Down Expand Up @@ -223,6 +264,7 @@ type runner_cli = {
disable_analy_warn : bool;
dump_callgraph : bool;
dump_callgraph_stdout : bool;
ipc_address : string;
}

let parse_cli args ~exe_name =
Expand All @@ -240,6 +282,7 @@ let parse_cli args ~exe_name =
let r_disable_analy_warn = ref false in
let r_dump_callgraph = ref false in
let r_dump_callgraph_stdout = ref false in
let r_ipc_address = ref "" in

let speclist =
[
Expand All @@ -263,13 +306,17 @@ let parse_cli args ~exe_name =
let g = try Some (Stdint.Uint64.of_string i) with _ -> None in
r_gas_limit := g),
"Gas limit" );
( "-ipcaddress",
Arg.String (fun x -> r_ipc_address := x),
"Socket address for IPC communication with blockchain for state access"
);
( "-gua",
Arg.Unit (fun () -> r_gua := true),
"Run gas use analysis and print use polynomial." );
( "-init",
Arg.String (fun x -> r_init := Some x),
"Initialization json" );
( "-islibrary", Arg.Unit (fun () -> r_is_library := true), "Is the contract a library?");
("-init", Arg.String (fun x -> r_init := Some x), "Initialization json");
( "-islibrary",
Arg.Unit (fun () -> r_is_library := true),
"Is the contract a library?" );
( "-cf",
Arg.Unit (fun () -> r_cf := true),
"Run cashflow checker and print results" );
Expand Down Expand Up @@ -351,4 +398,5 @@ let parse_cli args ~exe_name =
disable_analy_warn = !r_disable_analy_warn;
dump_callgraph = !r_dump_callgraph;
dump_callgraph_stdout = !r_dump_callgraph_stdout;
ipc_address = !r_ipc_address;
}
39 changes: 25 additions & 14 deletions src/eval/StateIPCClient.ml → src/base/StateIPCClient.ml
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,6 @@
*)
open Core
open Result.Let_syntax
open Scilla_base
open MonadUtil
open Literal
open ParserUtil
Expand Down Expand Up @@ -62,18 +61,24 @@ let http_rpc ~socket_addr (call : Rpc.call) : Rpc.response M.t =
DebugMessage.plog (Printf.sprintf "Sending: %s\n" msg_buf);
let exception Http_error of string in
let response =
match Ezcurl.post ~headers:["content-type", "application/json"] ~content:(`String msg_buf) ~params:[] ~url:socket_addr () with
match
Ezcurl.post
~headers:[ ("content-type", "application/json") ]
~content:(`String msg_buf) ~params:[] ~url:socket_addr ()
with
| Ok response -> response
| Error (_, err) -> (
DebugMessage.plog (Printf.sprintf "error calling RPC: %s" err);
raise (Http_error (Printf.sprintf "error calling RPC: %s" err))
)
| Error (_, err) ->
DebugMessage.plog (Printf.sprintf "error calling RPC: %s" err);
raise (Http_error (Printf.sprintf "error calling RPC: %s" err))
in

let response = if response.code = 200 then response.body else (
DebugMessage.plog (Printf.sprintf "error response from RPC: code: %d, body: %s" response.code response.body);
raise (Http_error "error response from RPC")
)
let response =
if response.code = 200 then response.body
else (
DebugMessage.plog
(Printf.sprintf "error response from RPC: code: %d, body: %s"
response.code response.body);
raise (Http_error "error response from RPC"))
in

DebugMessage.plog (Printf.sprintf "Response: %s\n" response);
Expand Down Expand Up @@ -143,7 +148,8 @@ let encode_serialized_value value =
try
let encoder = Pbrt.Encoder.create () in
Ipcmessage_pb.encode_proto_scilla_val value encoder;
pure @@ Base64.encode_exn @@ Bytes.to_string @@ Pbrt.Encoder.to_bytes encoder
pure @@ Base64.encode_exn @@ Bytes.to_string
@@ Pbrt.Encoder.to_bytes encoder
with e -> fail0 ~kind:(Exn.to_string e) ?inst:None

let decode_serialized_value value =
Expand All @@ -156,7 +162,8 @@ let encode_serialized_query query =
try
let encoder = Pbrt.Encoder.create () in
Ipcmessage_pb.encode_proto_scilla_query query encoder;
pure @@ Base64.encode_exn @@ Bytes.to_string @@ Pbrt.Encoder.to_bytes encoder
pure @@ Base64.encode_exn @@ Bytes.to_string
@@ Pbrt.Encoder.to_bytes encoder
with e -> fail0 ~kind:(Exn.to_string e) ?inst:None

(* Fetch from a field. "keys" is empty when fetching non-map fields or an entire Map field.
Expand All @@ -181,7 +188,9 @@ let fetch ~socket_addr ~fname ~keys ~tp =
match res with
| true, res' ->
let%bind tp' = TypeUtilities.map_access_type tp (List.length keys) in
let%bind decoded_pb = decode_serialized_value (Bytes.of_string (Base64.decode_exn res')) in
let%bind decoded_pb =
decode_serialized_value (Bytes.of_string (Base64.decode_exn res'))
in
let%bind res'' = deserialize_value decoded_pb tp' in
pure @@ Some res''
| false, _ -> pure None
Expand Down Expand Up @@ -232,7 +241,9 @@ let external_fetch ~socket_addr ~caddr ~fname ~keys ~ignoreval =
let%bind tp' =
TypeUtilities.map_access_type stored_typ (List.length keys)
in
let%bind decoded_pb = decode_serialized_value (Bytes.of_string (Base64.decode_exn res')) in
let%bind decoded_pb =
decode_serialized_value (Bytes.of_string (Base64.decode_exn res'))
in
let%bind res'' = deserialize_value decoded_pb tp' in
pure @@ (Some res'', Some stored_typ)
| false, _, _ -> pure (None, None)
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,6 @@
scilla. If not, see <http://www.gnu.org/licenses/>.
*)

open Scilla_base
open ErrorUtils
open Literal
module IPCCLiteral = GlobalLiteral
Expand Down
File renamed without changes.
1 change: 0 additions & 1 deletion src/eval/StateService.ml → src/base/StateService.ml
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,6 @@

open Core
open Result.Let_syntax
open Scilla_base
open MonadUtil
open TypeUtil
open ParserUtil
Expand Down
42 changes: 36 additions & 6 deletions src/base/dune
Original file line number Diff line number Diff line change
Expand Up @@ -13,17 +13,47 @@
(action
(with-stdout-to
ParserFaults.ml
(run %{bin:menhir} --compile-errors ParserFaults.messages ScillaParser.mly))))
(run
%{bin:menhir}
--compile-errors
ParserFaults.messages
ScillaParser.mly))))

(library
(name scilla_base)
(modes byte native)
(public_name scilla.base)
(wrapped true)
(libraries core core_unix core_unix.sys_unix num hex stdint angstrom
polynomials cryptokit vcpkg-secp256k1 bitstring yojson fileutils scilla_crypto
menhirLib ocamlgraph)
(libraries
core
core_unix
core_unix.sys_unix
num
lwt
hex
stdint
angstrom
polynomials
cryptokit
vcpkg-secp256k1
bitstring
yojson
fileutils
scilla_crypto
rpclib
ocaml-protoc
rpclib.json
menhirLib
ezcurl
ocamlgraph)
(preprocess
(pps ppx_sexp_conv ppx_deriving_yojson ppx_let ppx_deriving.show ppx_compare bisect_ppx
--conditional))
(pps
ppx_sexp_conv
ppx_deriving_yojson
ppx_let
ppx_deriving.show
ppx_compare
ppx_deriving_rpc
bisect_ppx
--conditional))
(synopsis "Scilla workbench implementation."))
1 change: 0 additions & 1 deletion src/eval/EvalUtil.ml
Original file line number Diff line number Diff line change
Expand Up @@ -564,7 +564,6 @@ module EvalTypecheck = struct
open MonadUtil
open Result.Let_syntax
(* Checks that _this_address is defined *)
let is_contract_addr ~caddr =
let this_id = EvalIdentifier.mk_loc_id this_address_label in
let%bind _, this_typ_opt =
Expand Down
20 changes: 16 additions & 4 deletions src/eval/dune
Original file line number Diff line number Diff line change
Expand Up @@ -3,9 +3,21 @@
(public_name scilla.eval)
(wrapped true)
(modes byte native)
(libraries core core_unix.sys_unix angstrom stdint yojson cryptokit
scilla_base rpclib unix rpclib.json rresult ocaml-protoc ezcurl)
(libraries
core
core_unix.sys_unix
angstrom
stdint
yojson
scilla_base
unix
rresult)
(preprocess
(pps ppx_sexp_conv ppx_let bisect_ppx --conditional ppx_deriving_rpc
ppx_deriving.show ppx_compare))
(pps
ppx_sexp_conv
ppx_let
bisect_ppx
--conditional
ppx_deriving.show
ppx_compare))
(synopsis "Scilla workbench implementation."))
2 changes: 1 addition & 1 deletion src/server/api.ml
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@
scilla. If not, see <http://www.gnu.org/licenses/>.
*)

open Scilla_eval
open Scilla_base
open Idl
open IPCUtil

Expand Down
2 changes: 1 addition & 1 deletion src/server/client.ml
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,7 @@
*)

open Core
open Scilla_eval
open Scilla_base
open Api
module U = Core_unix
module M = Idl.IdM
Expand Down

0 comments on commit 810578f

Please sign in to comment.