From 26a5338b86fecace1d13cd0434f0d6ba43977d39 Mon Sep 17 00:00:00 2001
From: Benjamin Canou <benjamin@canou.fr>
Date: Mon, 24 Jul 2017 15:57:03 +0200
Subject: [PATCH] Alpha: adds a command to get the storage of a contract

---
 .../embedded/alpha/client_proto_context.ml       | 16 ++++++++++++++++
 .../embedded/alpha/client_proto_programs.ml      |  3 +++
 .../embedded/alpha/client_proto_programs.mli     |  2 ++
 src/client/embedded/alpha/client_proto_rpcs.ml   |  2 ++
 src/client/embedded/alpha/client_proto_rpcs.mli  |  3 +++
 5 files changed, 26 insertions(+)

diff --git a/src/client/embedded/alpha/client_proto_context.ml b/src/client/embedded/alpha/client_proto_context.ml
index b22c3daab..c9153e116 100644
--- a/src/client/embedded/alpha/client_proto_context.ml
+++ b/src/client/embedded/alpha/client_proto_context.ml
@@ -17,6 +17,9 @@ module Ed25519 = Environment.Ed25519
 let get_balance cctxt block contract =
   Client_proto_rpcs.Context.Contract.balance cctxt block contract
 
+let get_storage cctxt block contract =
+  Client_proto_rpcs.Context.Contract.storage cctxt block contract
+
 let rec find_predecessor rpc_config h n =
   if n <= 0 then
     return (`Hash h)
@@ -260,6 +263,19 @@ let commands () =
       return ()
     end ;
 
+    command ~group ~desc: "get the storage of a contract" begin
+      prefixes [ "get" ; "storage" ; "for" ]
+      @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
+      @@ stop
+    end begin fun (_, contract) cctxt ->
+      get_storage cctxt.rpc_config cctxt.config.block contract >>=? function
+      | None ->
+          cctxt.error "This is not a smart contract."
+      | Some storage ->
+          cctxt.answer "%a" Client_proto_programs.print_storage storage >>= fun () ->
+          return ()
+    end ;
+
     command ~group ~desc: "get the manager of a contract" begin
       prefixes [ "get" ; "manager" ; "for" ]
       @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
diff --git a/src/client/embedded/alpha/client_proto_programs.ml b/src/client/embedded/alpha/client_proto_programs.ml
index 08a6621ce..e5f87b9b4 100644
--- a/src/client/embedded/alpha/client_proto_programs.ml
+++ b/src/client/embedded/alpha/client_proto_programs.ml
@@ -83,6 +83,9 @@ and print_expr locations ppf = function
       Format.fprintf ppf "(%a)" (print_expr_unwrapped locations) expr
   | expr -> print_expr_unwrapped locations ppf expr
 
+let print_storage ppf ({ storage } : Script.storage) =
+  print_expr no_locations ppf storage
+
 let print_stack ppf = function
   | [] -> Format.fprintf ppf "[]"
   | more ->
diff --git a/src/client/embedded/alpha/client_proto_programs.mli b/src/client/embedded/alpha/client_proto_programs.mli
index 9fecea669..d74da2070 100644
--- a/src/client/embedded/alpha/client_proto_programs.mli
+++ b/src/client/embedded/alpha/client_proto_programs.mli
@@ -16,6 +16,8 @@ val parse_program: string -> Script.code parsed tzresult Lwt.t
 val parse_data: string -> Script.expr parsed tzresult Lwt.t
 val parse_data_type: string -> Script.expr parsed tzresult Lwt.t
 
+val print_storage: Format.formatter -> Script.storage -> unit
+
 module Program : Client_aliases.Alias with type t = Script.code parsed
 
 val commands: unit -> Client_commands.command list
diff --git a/src/client/embedded/alpha/client_proto_rpcs.ml b/src/client/embedded/alpha/client_proto_rpcs.ml
index def6ee747..f4d15459e 100644
--- a/src/client/embedded/alpha/client_proto_rpcs.ml
+++ b/src/client/embedded/alpha/client_proto_rpcs.ml
@@ -132,6 +132,8 @@ module Context = struct
       call_error_service2 cctxt Services.Context.Contract.delegatable b c ()
     let script cctxt b c =
       call_error_service2 cctxt Services.Context.Contract.script b c ()
+    let storage cctxt b c =
+      call_error_service2 cctxt Services.Context.Contract.storage b c ()
   end
 
 end
diff --git a/src/client/embedded/alpha/client_proto_rpcs.mli b/src/client/embedded/alpha/client_proto_rpcs.mli
index 846c8aba3..dfb8d9c55 100644
--- a/src/client/embedded/alpha/client_proto_rpcs.mli
+++ b/src/client/embedded/alpha/client_proto_rpcs.mli
@@ -135,6 +135,9 @@ module Context : sig
     val script:
       Client_rpcs.config ->
       block -> Contract.t -> Script.t option tzresult Lwt.t
+    val storage:
+      Client_rpcs.config ->
+      block -> Contract.t -> Script.storage option tzresult Lwt.t
   end
 end