From db6a68a08fd886b8801f8b38f1fb826c9f2adc45 Mon Sep 17 00:00:00 2001
From: Benjamin Canou <benjamin@canou.fr>
Date: Tue, 15 Nov 2016 15:58:18 +0100
Subject: [PATCH] Proto: RPC to run an arbitrary program on arbitrary data.

---
 .../bootstrap/client_proto_programs.ml        | 21 +++++++++++++++
 .../embedded/bootstrap/client_proto_rpcs.ml   |  4 +++
 .../embedded/bootstrap/client_proto_rpcs.mli  |  3 +++
 src/proto/bootstrap/services.ml               | 15 +++++++++++
 src/proto/bootstrap/services_registration.ml  | 27 +++++++++++++++++++
 5 files changed, 70 insertions(+)

diff --git a/src/client/embedded/bootstrap/client_proto_programs.ml b/src/client/embedded/bootstrap/client_proto_programs.ml
index df8f36185..41cb89700 100644
--- a/src/client/embedded/bootstrap/client_proto_programs.ml
+++ b/src/client/embedded/bootstrap/client_proto_programs.ml
@@ -198,6 +198,27 @@ let commands () =
          Program.to_source program >>= fun source ->
          Format.printf "%s\n" source ;
          Lwt.return ()) ;
+    command
+      ~group: "programs"
+      ~desc: "ask the node to run a program"
+      (prefixes [ "run" ; "program" ]
+       @@ Program.source_param
+       @@ prefixes [ "on" ; "storage" ]
+       @@ Cli_entries.param ~name:"storage" ~desc:"the untagged storage data" parse_data
+       @@ prefixes [ "and" ; "input" ]
+       @@ Cli_entries.param ~name:"storage" ~desc:"the untagged input data" parse_data
+       @@ stop)
+      (fun program storage input () ->
+         let open Data_encoding in
+         Client_proto_rpcs.Helpers.run_code (block ()) program (storage, input) >>= function
+         | Ok (storage, output) ->
+             Format.printf "@[<v 0>@[<v 2>storage@,%a@]@,@[<v 2>output@,%a@]@]@."
+               (print_ir (fun l -> false)) storage
+               (print_ir (fun l -> false)) output ;
+             Lwt.return ()
+         | Error errs ->
+             pp_print_error Format.err_formatter errs ;
+             error "error running program") ;
     command
       ~group: "programs"
       ~desc: "ask the node to typecheck a program"
diff --git a/src/client/embedded/bootstrap/client_proto_rpcs.ml b/src/client/embedded/bootstrap/client_proto_rpcs.ml
index 5649310d8..c6c42c93f 100644
--- a/src/client/embedded/bootstrap/client_proto_rpcs.ml
+++ b/src/client/embedded/bootstrap/client_proto_rpcs.ml
@@ -127,6 +127,10 @@ module Helpers = struct
 
   let typecheck_code = call_error_service1 Services.Helpers.typecheck_code
 
+  let run_code block code (storage, input) =
+    call_error_service1 Services.Helpers.run_code
+      block (code, storage, input, None, None)
+
   let typecheck_tagged_data = call_error_service1 Services.Helpers.typecheck_tagged_data
 
   let typecheck_untagged_data = call_error_service1 Services.Helpers.typecheck_untagged_data
diff --git a/src/client/embedded/bootstrap/client_proto_rpcs.mli b/src/client/embedded/bootstrap/client_proto_rpcs.mli
index 5e72f93d2..f0932ac12 100644
--- a/src/client/embedded/bootstrap/client_proto_rpcs.mli
+++ b/src/client/embedded/bootstrap/client_proto_rpcs.mli
@@ -92,6 +92,9 @@ end
 module Helpers : sig
   val minimal_time:
     block -> ?prio:int -> unit -> Time.t tzresult Lwt.t
+  val run_code: block -> Script.code ->
+    (Script.expr * Script.expr) ->
+    (Script.expr * Script.expr) tzresult Lwt.t
   val typecheck_code: block -> Script.code -> Script_ir_translator.type_map tzresult Lwt.t
   val typecheck_tagged_data: block -> Script.expr -> unit tzresult Lwt.t
   val typecheck_untagged_data: block -> Script.expr * Script.expr -> unit tzresult Lwt.t
diff --git a/src/proto/bootstrap/services.ml b/src/proto/bootstrap/services.ml
index 987610ed9..2b07c8baa 100644
--- a/src/proto/bootstrap/services.ml
+++ b/src/proto/bootstrap/services.ml
@@ -327,6 +327,21 @@ module Helpers = struct
                 obj1 (req "timestamp" Timestamp.encoding))
       RPC.Path.(custom_root / "helpers" / "minimal_timestamp")
 
+  let run_code custom_root =
+    RPC.service
+      ~description: "Run a piece of code in the current context"
+      ~input: (obj5
+                 (req "script" Script.code_encoding)
+                 (req "storage" Script.expr_encoding)
+                 (req "input" Script.expr_encoding)
+                 (opt "amount" Tez.encoding)
+                 (opt "contract" Contract.encoding))
+      ~output: (wrap_tzerror
+                  (obj2
+                     (req "storage" Script.expr_encoding)
+                     (req "output" Script.expr_encoding)))
+      RPC.Path.(custom_root / "helpers" / "run_code")
+
   let typecheck_code custom_root =
     RPC.service
       ~description: "Typecheck a piece of code in the current context"
diff --git a/src/proto/bootstrap/services_registration.ml b/src/proto/bootstrap/services_registration.ml
index edbfeea33..3045561ce 100644
--- a/src/proto/bootstrap/services_registration.ml
+++ b/src/proto/bootstrap/services_registration.ml
@@ -179,6 +179,33 @@ let minimal_timestamp ctxt prio =
 
 let () = register1 Services.Helpers.minimal_timestamp minimal_timestamp
 
+let () =
+  register1 Services.Helpers.run_code
+    (fun ctxt (script, storage, input, amount, contract) ->
+       let amount =
+         match amount with
+         | Some amount -> amount
+         | None ->
+             match Tez.of_cents 100_00L with
+             | Some tez -> tez
+             | None -> Tez.zero in
+       let contract =
+         match contract with
+         | Some contract -> contract
+         | None ->
+             Contract.default_contract
+               (List.hd Bootstrap.accounts).Bootstrap.public_key_hash in
+       let storage =
+         { Script.storage ; storage_type = script.storage_type } in
+       let qta =
+         Constants.instructions_per_transaction ctxt in
+       Script_interpreter.execute
+         contract (* transaction initiator *)
+         contract (* script owner *)
+         ctxt storage script amount input
+         qta >>=? fun (sto, ret, _qta, _ctxt) ->
+       Error_monad.return (sto, ret))
+
 let () =
   register1 Services.Helpers.typecheck_code
     Script_ir_translator.typecheck_code