From 810578f3e4fae4c1ad496e4a438887de138b9c3a Mon Sep 17 00:00:00 2001 From: saeed-zil Date: Wed, 6 Nov 2024 14:54:46 +0330 Subject: [PATCH] Fetch external libraries from Zilliqa --- src/base/Checker.ml | 18 +++--- src/{eval => base}/IPCUtil.ml | 0 src/{eval => base}/Ipcmessage.proto | 0 src/{eval => base}/Ipcmessage_pb.ml | 0 src/{eval => base}/Ipcmessage_pb.mli | 0 src/{eval => base}/Ipcmessage_types.ml | 0 src/{eval => base}/Ipcmessage_types.mli | 0 src/base/RunnerUtil.ml | 74 ++++++++++++++++++++----- src/{eval => base}/StateIPCClient.ml | 39 ++++++++----- src/{eval => base}/StateIPCClient.mli | 1 - src/{eval => base}/StateIPCIdl.ml | 0 src/{eval => base}/StateService.ml | 1 - src/base/dune | 42 ++++++++++++-- src/eval/EvalUtil.ml | 1 - src/eval/dune | 20 +++++-- src/server/api.ml | 2 +- src/server/client.ml | 2 +- 17 files changed, 151 insertions(+), 49 deletions(-) rename src/{eval => base}/IPCUtil.ml (100%) rename src/{eval => base}/Ipcmessage.proto (100%) rename src/{eval => base}/Ipcmessage_pb.ml (100%) rename src/{eval => base}/Ipcmessage_pb.mli (100%) rename src/{eval => base}/Ipcmessage_types.ml (100%) rename src/{eval => base}/Ipcmessage_types.mli (100%) rename src/{eval => base}/StateIPCClient.ml (91%) rename src/{eval => base}/StateIPCClient.mli (99%) rename src/{eval => base}/StateIPCIdl.ml (100%) rename src/{eval => base}/StateService.ml (99%) diff --git a/src/base/Checker.ml b/src/base/Checker.ml index a75b33954..16ec119e6 100644 --- a/src/base/Checker.ml +++ b/src/base/Checker.ml @@ -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 @@ -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 @@ -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 () @@ -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 @@ -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 diff --git a/src/eval/IPCUtil.ml b/src/base/IPCUtil.ml similarity index 100% rename from src/eval/IPCUtil.ml rename to src/base/IPCUtil.ml diff --git a/src/eval/Ipcmessage.proto b/src/base/Ipcmessage.proto similarity index 100% rename from src/eval/Ipcmessage.proto rename to src/base/Ipcmessage.proto diff --git a/src/eval/Ipcmessage_pb.ml b/src/base/Ipcmessage_pb.ml similarity index 100% rename from src/eval/Ipcmessage_pb.ml rename to src/base/Ipcmessage_pb.ml diff --git a/src/eval/Ipcmessage_pb.mli b/src/base/Ipcmessage_pb.mli similarity index 100% rename from src/eval/Ipcmessage_pb.mli rename to src/base/Ipcmessage_pb.mli diff --git a/src/eval/Ipcmessage_types.ml b/src/base/Ipcmessage_types.ml similarity index 100% rename from src/eval/Ipcmessage_types.ml rename to src/base/Ipcmessage_types.ml diff --git a/src/eval/Ipcmessage_types.mli b/src/base/Ipcmessage_types.mli similarity index 100% rename from src/eval/Ipcmessage_types.mli rename to src/base/Ipcmessage_types.mli diff --git a/src/base/RunnerUtil.ml b/src/base/RunnerUtil.ml index 9d563c131..b6f8a7c68 100644 --- a/src/base/RunnerUtil.ml +++ b/src/base/RunnerUtil.ml @@ -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 @@ -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) @@ -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 = @@ -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 = [ @@ -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" ); @@ -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; } diff --git a/src/eval/StateIPCClient.ml b/src/base/StateIPCClient.ml similarity index 91% rename from src/eval/StateIPCClient.ml rename to src/base/StateIPCClient.ml index ccb396091..b0d6ddb32 100644 --- a/src/eval/StateIPCClient.ml +++ b/src/base/StateIPCClient.ml @@ -17,7 +17,6 @@ *) open Core open Result.Let_syntax -open Scilla_base open MonadUtil open Literal open ParserUtil @@ -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); @@ -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 = @@ -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. @@ -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 @@ -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) diff --git a/src/eval/StateIPCClient.mli b/src/base/StateIPCClient.mli similarity index 99% rename from src/eval/StateIPCClient.mli rename to src/base/StateIPCClient.mli index a208f2069..befddce0f 100644 --- a/src/eval/StateIPCClient.mli +++ b/src/base/StateIPCClient.mli @@ -16,7 +16,6 @@ scilla. If not, see . *) -open Scilla_base open ErrorUtils open Literal module IPCCLiteral = GlobalLiteral diff --git a/src/eval/StateIPCIdl.ml b/src/base/StateIPCIdl.ml similarity index 100% rename from src/eval/StateIPCIdl.ml rename to src/base/StateIPCIdl.ml diff --git a/src/eval/StateService.ml b/src/base/StateService.ml similarity index 99% rename from src/eval/StateService.ml rename to src/base/StateService.ml index b1bd3814f..4a20f1bcd 100644 --- a/src/eval/StateService.ml +++ b/src/base/StateService.ml @@ -18,7 +18,6 @@ open Core open Result.Let_syntax -open Scilla_base open MonadUtil open TypeUtil open ParserUtil diff --git a/src/base/dune b/src/base/dune index 0992bacce..fbb400994 100644 --- a/src/base/dune +++ b/src/base/dune @@ -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.")) diff --git a/src/eval/EvalUtil.ml b/src/eval/EvalUtil.ml index 808562f67..c82666ac6 100644 --- a/src/eval/EvalUtil.ml +++ b/src/eval/EvalUtil.ml @@ -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 = diff --git a/src/eval/dune b/src/eval/dune index 10e174075..439dd6f07 100644 --- a/src/eval/dune +++ b/src/eval/dune @@ -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.")) diff --git a/src/server/api.ml b/src/server/api.ml index 44135469a..6b1f0ed84 100644 --- a/src/server/api.ml +++ b/src/server/api.ml @@ -16,7 +16,7 @@ scilla. If not, see . *) -open Scilla_eval +open Scilla_base open Idl open IPCUtil diff --git a/src/server/client.ml b/src/server/client.ml index 43fe77892..a03d019ae 100644 --- a/src/server/client.ml +++ b/src/server/client.ml @@ -17,7 +17,7 @@ *) open Core -open Scilla_eval +open Scilla_base open Api module U = Core_unix module M = Idl.IdM