From 306b13874a6473dd374cae3ed69b26d4253f9743 Mon Sep 17 00:00:00 2001 From: James Hinshelwood Date: Wed, 28 Feb 2024 12:46:04 +0000 Subject: [PATCH] http --- docker/Dockerfile | 3 +- package.json | 4 +- scilla.opam | 2 + src/eval/StateIPCClient.ml | 39 ++++++++--------- src/eval/dune | 2 +- src/runners/dune | 8 ++-- src/runners/scilla_server_http.ml | 71 +++++++++++++++++++++++++++++++ 7 files changed, 101 insertions(+), 28 deletions(-) create mode 100644 src/runners/scilla_server_http.ml diff --git a/docker/Dockerfile b/docker/Dockerfile index 42c1671b1..c1a4a88ed 100644 --- a/docker/Dockerfile +++ b/docker/Dockerfile @@ -18,6 +18,7 @@ RUN apt-get update -y \ git \ lcov \ libcurl4-openssl-dev \ + libev-dev \ libgmp-dev \ libpcre3-dev \ libssl-dev \ @@ -119,9 +120,9 @@ FROM ubuntu:22.04 RUN apt-get update -y \ && apt-get install -y build-essential \ + libev-dev \ libgmp-dev ARG SOURCE_DIR="/scilla/${MAJOR_VERSION}" COPY --from=builder ${SOURCE_DIR} ${SOURCE_DIR} - diff --git a/package.json b/package.json index 2c36fcfdf..841862b85 100644 --- a/package.json +++ b/package.json @@ -48,7 +48,9 @@ "@opam/ppx_deriving_rpc": ">=6.0.0 <10.0.0", "@opam/secp256k1": ">=0.4.4 <0.5.0", "@opam/stdint": ">=0.5.1 <0.8.0", - "@opam/yojson": ">=1.7.0 <2.1.0" + "@opam/yojson": ">=1.7.0 <2.1.0", + "@opam/opium": ">=0.20.0 <1.0.0", + "@opam/ezcurl": ">=0.2.4 <0.3.0" }, "devDependencies": { "@opam/merlin": "*", diff --git a/scilla.opam b/scilla.opam index 601c115dd..6b8d4d718 100644 --- a/scilla.opam +++ b/scilla.opam @@ -49,6 +49,8 @@ depends: [ "seq" "stdint" {>= "0.5.1" & < "0.8~"} "yojson" {>= "1.7.0" & < "2.1~"} + "opium" {>= "0.20.0" & < "1.0.0"} + "ezcurl" {>= "0.2.4" & < "0.3.0"} ] build: [ [ "./scripts/build_deps.sh" ] diff --git a/src/eval/StateIPCClient.ml b/src/eval/StateIPCClient.ml index bb74f47b7..c4fffd1ce 100644 --- a/src/eval/StateIPCClient.ml +++ b/src/eval/StateIPCClient.ml @@ -55,22 +55,19 @@ let ipcclient_exn_wrapper thunk = fail0 ~kind:"StateIPCClient: Unexpected error making JSON-RPC call" ?inst:None -let binary_rpc ~socket_addr (call : Rpc.call) : Rpc.response M.t = - let socket = - Core_unix.socket ~domain:Core_unix.PF_UNIX ~kind:Core_unix.SOCK_STREAM - ~protocol:0 () - in - Core_unix.connect socket ~addr:(Core_unix.ADDR_UNIX socket_addr); - let ic = Core_unix.in_channel_of_descr socket in - let oc = Core_unix.out_channel_of_descr socket in +let http_rpc ~socket_addr (call : Rpc.call) : Rpc.response M.t = let msg_buf = Jsonrpc.string_of_call ~version:Jsonrpc.V2 call in - DebugMessage.plog (Printf.sprintf "Sending: %s\n" msg_buf); - (* Send data to the socket. *) - let _ = send_delimited oc msg_buf in - (* Get response. *) - let response = Caml.input_line ic in - Core_unix.close socket; - DebugMessage.plog (Printf.sprintf "Response: %s\n" response); + print_endline (Printf.sprintf "Sending: %s\n" msg_buf); + let exception Http_error of string in + let response = + match Ezcurl.post ~content:(`String msg_buf) ~params:[] ~url:socket_addr () with + | Ok response -> response + | Error (_, err) -> raise (Http_error (Printf.sprintf "error calling RPC: %s " err)) + in + + let response = if response.code = 200 then response.body else raise (Http_error "error response from RPC") in + + print_endline (Printf.sprintf "Response: %s\n" response); M.return @@ Jsonrpc.response_of_string response (* Encode a literal into bytes, opaque to the backend storage. *) @@ -168,7 +165,7 @@ let fetch ~socket_addr ~fname ~keys ~tp = let%bind q' = encode_serialized_query q in let%bind res = let thunk () = - translate_res @@ IPCClient.fetch_state_value (binary_rpc ~socket_addr) q' + translate_res @@ IPCClient.fetch_state_value (http_rpc ~socket_addr) q' in ipcclient_exn_wrapper thunk in @@ -211,7 +208,7 @@ let external_fetch ~socket_addr ~caddr ~fname ~keys ~ignoreval = let%bind res = let thunk () = translate_res - @@ IPCClient.fetch_ext_state_value (binary_rpc ~socket_addr) caddr q' + @@ IPCClient.fetch_ext_state_value (http_rpc ~socket_addr) caddr q' in ipcclient_exn_wrapper thunk in @@ -247,7 +244,7 @@ let update ~socket_addr ~fname ~keys ~value ~tp = let%bind () = let thunk () = translate_res - @@ IPCClient.update_state_value (binary_rpc ~socket_addr) q' value' + @@ IPCClient.update_state_value (http_rpc ~socket_addr) q' value' in ipcclient_exn_wrapper thunk in @@ -267,7 +264,7 @@ let is_member ~socket_addr ~fname ~keys ~tp = let%bind q' = encode_serialized_query q in let%bind res = let thunk () = - translate_res @@ IPCClient.fetch_state_value (binary_rpc ~socket_addr) q' + translate_res @@ IPCClient.fetch_state_value (http_rpc ~socket_addr) q' in ipcclient_exn_wrapper thunk in @@ -290,7 +287,7 @@ let remove ~socket_addr ~fname ~keys ~tp = let%bind () = let thunk () = translate_res - @@ IPCClient.update_state_value (binary_rpc ~socket_addr) q' dummy_val + @@ IPCClient.update_state_value (http_rpc ~socket_addr) q' dummy_val in ipcclient_exn_wrapper thunk in @@ -304,7 +301,7 @@ let fetch_bcinfo ~socket_addr ~query_name ~query_args = let%bind res = let thunk () = translate_res - @@ IPCClient.fetch_bcinfo (binary_rpc ~socket_addr) query_name query_args + @@ IPCClient.fetch_bcinfo (http_rpc ~socket_addr) query_name query_args in ipcclient_exn_wrapper thunk in diff --git a/src/eval/dune b/src/eval/dune index 19a291c24..10e174075 100644 --- a/src/eval/dune +++ b/src/eval/dune @@ -4,7 +4,7 @@ (wrapped true) (modes byte native) (libraries core core_unix.sys_unix angstrom stdint yojson cryptokit - scilla_base rpclib unix rpclib.json rresult ocaml-protoc) + scilla_base rpclib unix rpclib.json rresult ocaml-protoc ezcurl) (preprocess (pps ppx_sexp_conv ppx_let bisect_ppx --conditional ppx_deriving_rpc ppx_deriving.show ppx_compare)) diff --git a/src/runners/dune b/src/runners/dune index c5d7ad6cd..e78418762 100644 --- a/src/runners/dune +++ b/src/runners/dune @@ -1,14 +1,14 @@ (executables (names scilla_runner eval_runner type_checker scilla_checker scilla_server - disambiguate_state_json scilla_fmt scilla_merger) + disambiguate_state_json scilla_fmt scilla_merger scilla_server_http) (public_names scilla-runner eval-runner type-checker scilla-checker - scilla-server disambiguate_state_json scilla-fmt scilla-merger) + scilla-server disambiguate_state_json scilla-fmt scilla-merger scilla-server-http) (package scilla) (modules scilla_runner eval_runner type_checker scilla_checker scilla_server - disambiguate_state_json scilla_fmt scilla_merger) + disambiguate_state_json scilla_fmt scilla_merger scilla_server_http) (libraries core core_unix.command_unix angstrom yojson cryptokit fileutils scilla_base scilla_eval scilla_server_lib scilla_crypto scilla_format - scilla_merge cmdliner) + scilla_merge cmdliner opium) (modes byte native) (preprocess (pps ppx_sexp_conv ppx_deriving_yojson ppx_let ppx_deriving.show bisect_ppx --conditional))) diff --git a/src/runners/scilla_server_http.ml b/src/runners/scilla_server_http.ml new file mode 100644 index 000000000..30586e24c --- /dev/null +++ b/src/runners/scilla_server_http.ml @@ -0,0 +1,71 @@ +open Core +open Scilla_eval +open Opium +open Yojson.Safe +open Core +open Scilla_base +open Scilla_server_lib.Api +open IPCUtil +open ErrorUtils + +module M = Idl.IdM +module IDL = Idl.Make (M) +module Server = API (IDL.GenServer ()) + +let mk_handler_no_args callback () = + try IDL.ErrM.return @@ callback () + with FatalError msg -> + IDL.ErrM.return_err RPCError.{ code = 0; message = msg } + +(* Makes a handler that executes the given [callback] with [args] and returns it. **) +let mk_handler callback args = + (* Force the -jsonerrors flag *) + let args = "-jsonerrors" :: args in + try IDL.ErrM.return @@ callback (Some args) + with FatalError msg -> + IDL.ErrM.return_err RPCError.{ code = 0; message = msg } + +let server_implementation () = + let runner args = + let output, _ = Runner.run args ~exe_name:"scilla-runner" in + Yojson.Basic.pretty_to_string output + in + let disambiguator args = + Disambiguator.run args ~exe_name:"scilla-disambiguator" + in + let version () = + let major, minor, patch = Syntax.scilla_version in + Printf.sprintf "{ \"scilla_version\": \"%d.%d.%d\" }" major minor patch + in + (* Handlers *) + Server.runner @@ mk_handler runner; + Server.checker @@ mk_handler (Checker.run ~exe_name:"scilla-checker"); + Server.disambiguator @@ mk_handler disambiguator; + Server.version @@ mk_handler_no_args version; + Server.implementation + +let run_handler req = + let open Lwt.Syntax in + let+ req = Request.to_plain_text req in + let req = Jsonrpc.call_of_string req in + + let rpc = IDL.server (server_implementation ()) in + let res = + try M.run (rpc req) + with e -> + print_endline (Exn.to_string e); + Rpc.failure + (RPCError.rpc_of_t + RPCError. + { code = 0; message = "scilla-server: incorrect invocation" }) + in + let str = Jsonrpc.string_of_response ~version:Jsonrpc.V2 res in + + Response.of_plain_text str +;; + +let _ = + App.empty + |> App.post "/run" run_handler + |> App.run_command +;;