Michelson: adds -amount flag to run program

src/client/embedded/alpha/client_proto_args.ml

@@ -15,16 +15,6 @@ let tez_of_string s =
   | None -> invalid_arg "tez_of_string"
   | Some t -> t
 
-let fee = ref (tez_of_string "0.05")
-let fee_arg =
-  "-fee",
-  Arg.String (fun s ->
-      try fee := tez_of_string s
-      with _ -> raise (Arg.Bad "invalid \xEA\x9C\xA9 notation in parameter -fee")),
-  "The fee in \xEA\x9C\xA9 to pay to the miner.\n\
-   default: \'0.05\"\n\
-   text format: D,DDD,DDD.DD (centiles are optional, comas are optional)"
-
 let init = ref "Unit"
 let init_arg =
   "-init",
@@ -79,16 +69,37 @@ let delegatable_args =
     Arg.Clear delegatable,
     "Set the created contract to be non delegatable (default)" ]
 
+let tez_format = "text format: D,DDD,DDD.DD (centiles are optional, commas are optional)"
+
+let tez_arg ~name ~desc ~default =
+  let ref_cell = ref (tez_of_string default) in
+  (ref_cell,
+   (name,
+    Arg.String (fun s ->
+        try ref_cell := tez_of_string s
+        with _ -> raise (Arg.Bad
+                           ("invalid \xEA\x9C\xA9 notation in parameter " ^ name))),
+    (Printf.sprintf
+       "%s\ndefault: \"%s\"\n%s"
+       desc
+       default
+       tez_format)))
+
 let tez_param ~name ~desc next =
   Cli_entries.param
     name
-    (desc ^ " in \xEA\x9C\xA9\n\
-             text format: D,DDD,DDD.DD (centiles and comas are optional)")
+    (desc ^ " in \xEA\x9C\xA9\n" ^ tez_format)
     (fun _ s ->
        try return (tez_of_string s)
        with _ -> failwith "invalid \xEA\x9C\xA9 notation")
     next
 
+let fee, fee_arg =
+  tez_arg
+    ~name:"-fee"
+    ~desc:"The fee in \xEA\x9C\xA9 to pay to the miner."
+    ~default:"0.05"
+
 let max_priority = ref None
 let max_priority_arg =
   "-max-priority",

src/client/embedded/alpha/client_proto_args.mli

@@ -21,6 +21,11 @@ val free_mining_arg: string * Arg.spec * string
 val force_arg: string * Arg.spec * string
 val endorsement_delay_arg: string * Arg.spec * string
 
+val tez_arg :
+  name:string ->
+  desc:string ->
+  default:string ->
+  Tez.tez ref * (string * Arg.spec * string)
 val tez_param :
   name:string ->
   desc:string ->

src/client/embedded/alpha/client_proto_programs.ml

@@ -535,6 +535,11 @@ let commands () =
     "-trace-stack",
     Arg.Set trace_stack,
     "Show the stack after each step" in
+  let amount, amount_arg =
+    Client_proto_args.tez_arg
+      ~name:"-amount"
+      ~desc:"The amount of the transfer in \xEA\x9C\xA9."
+      ~default: "0.00" in
   [
 
     command ~group ~desc: "lists all known programs"
@@ -567,7 +572,7 @@ let commands () =
          return ()) ;
 
     command ~group ~desc: "ask the node to run a program"
-      ~args: [ trace_stack_arg ]
+      ~args: [ trace_stack_arg ; amount_arg ]
       (prefixes [ "run" ; "program" ]
        @@ Program.source_param
        @@ prefixes [ "on" ; "storage" ]
@@ -581,7 +586,7 @@ let commands () =
          let open Data_encoding in
          if !trace_stack then
            Client_proto_rpcs.Helpers.trace_code cctxt.rpc_config
-             cctxt.config.block program (storage, input) >>= function
+             cctxt.config.block program (storage, input, !amount) >>= function
            | Ok (storage, output, trace) ->
                cctxt.message
                  "@[<v 0>@[<v 2>storage@,%a@]@,\
@@ -604,7 +609,7 @@ let commands () =
                return ()
          else
            Client_proto_rpcs.Helpers.run_code cctxt.rpc_config
-             cctxt.config.block program (storage, input) >>= function
+             cctxt.config.block program (storage, input, !amount) >>= function
            | Ok (storage, output) ->
                cctxt.message "@[<v 0>@[<v 2>storage@,%a@]@,@[<v 2>output@,%a@]@]@."
                  (print_expr no_locations) storage

src/client/embedded/alpha/client_proto_rpcs.ml

@@ -148,13 +148,13 @@ module Helpers = struct
     call_error_service1 cctxt Services.Helpers.apply_operation
       block (pred_block, hash, forged_operation, signature)
 
-  let run_code cctxt block code (storage, input) =
+  let run_code cctxt block code (storage, input, amount) =
     call_error_service1 cctxt Services.Helpers.run_code
-      block (code, storage, input, None, None, None)
+      block (code, storage, input, amount, None, None)
 
-  let trace_code cctxt block code (storage, input) =
+  let trace_code cctxt block code (storage, input, amount) =
     call_error_service1 cctxt Services.Helpers.trace_code
-      block (code, storage, input, None, None, None)
+      block (code, storage, input, amount, None, None)
 
   let typecheck_data cctxt =
     call_error_service1 cctxt Services.Helpers.typecheck_data

src/client/embedded/alpha/client_proto_rpcs.mli

@@ -153,12 +153,12 @@ module Helpers : sig
   val run_code:
     Client_rpcs.config ->
     block -> Script.code ->
-    (Script.expr * Script.expr) ->
+    (Script.expr * Script.expr * Tez.t) ->
     (Script.expr * Script.expr) tzresult Lwt.t
   val trace_code:
     Client_rpcs.config ->
     block -> Script.code ->
-    (Script.expr * Script.expr) ->
+    (Script.expr * Script.expr * Tez.t) ->
     (Script.expr * Script.expr *
      (Script.location * int * Script.expr list) list) tzresult Lwt.t
   val typecheck_code:

src/proto/alpha/services.ml

@@ -361,7 +361,7 @@ module Helpers = struct
        (req "script" Script.code_encoding)
        (req "storage" Script.expr_encoding)
        (req "input" Script.expr_encoding)
-       (opt "amount" Tez.encoding)
+       (req "amount" Tez.encoding)
        (opt "contract" Contract.encoding)
        (opt "origination_nonce" Contract.origination_nonce_encoding))
 

src/proto/alpha/services_registration.ml

@@ -258,13 +258,6 @@ let () =
            | (_ctxt, _, Some script_err) -> Lwt.return (Error script_err)
            | (_ctxt, contracts, None) -> Lwt.return (Ok contracts)) ;
   let run_parameters ctxt (script, storage, input, amount, contract, origination_nonce) =
-    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

test/scripts/fail_amount.tez

@@ -0,0 +1,5 @@
+# Fail if the amount transferred is less than 10
+parameter unit;
+storage unit;
+return unit;
+code {CAAR; PUSH tez "10"; CMPGT; IF {FAIL} {UNIT; UNIT; PAIR}}