Source file client_proto_context_commands.ml

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(* Copyright (c) 2019 Nomadic Labs <contact@nomadic-labs.com>                *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Protocol
open Alpha_context
open Tezos_micheline
open Client_proto_context
open Client_proto_contracts
open Client_proto_programs
open Client_keys_v0
open Client_proto_args

let encrypted_switch =
  Tezos_clic.switch ~long:"encrypted" ~doc:"encrypt the key on-disk" ()

let dry_run_switch =
  Tezos_clic.switch
    ~long:"dry-run"
    ~short:'D'
    ~doc:"don't inject the operation, just display it"
    ()

let verbose_signing_switch =
  Tezos_clic.switch
    ~long:"verbose-signing"
    ~doc:"display extra information before signing the operation"
    ()

let simulate_switch =
  Tezos_clic.switch
    ~long:"simulation"
    ~doc:
      "Simulate the execution of the command, without needing any signatures."
    ()

let force_switch =
  Tezos_clic.switch
    ~long:"force"
    ~doc:
      "Inject the operation even if the simulation results in a failure. This \
       switch requires --gas-limit, --storage-limit, and --fee."
    ()

let report_michelson_errors ?(no_print_source = false) ~msg
    (cctxt : #Client_context.printer) = function
  | Error errs ->
      cctxt#warning
        "%a"
        (Michelson_v1_error_reporter.report_errors
           ~details:(not no_print_source)
           ~show_source:(not no_print_source)
           ?parsed:None)
        errs
      >>= fun () ->
      cctxt#error "%s" msg >>= fun () -> Lwt.return_none
  | Ok data -> Lwt.return_some data

let json_file_or_text_parameter =
  Tezos_clic.parameter (fun _ p ->
      match String.split ~limit:1 ':' p with
      | ["text"; text] -> return (Ezjsonm.from_string text)
      | ["file"; path] -> Lwt_utils_unix.Json.read_file path
      | _ -> (
          if Sys.file_exists p then Lwt_utils_unix.Json.read_file p
          else
            try return (Ezjsonm.from_string p)
            with Ezjsonm.Parse_error _ ->
              failwith "Neither an existing file nor valid JSON: '%s'" p))

let non_negative_param =
  Tezos_clic.parameter (fun _ s ->
      match int_of_string_opt s with
      | Some i when i >= 0 -> return i
      | _ -> failwith "Parameter should be a non-negative integer literal")

let block_hash_param =
  Tezos_clic.parameter (fun _ s ->
      try return (Block_hash.of_b58check_exn s)
      with _ -> failwith "Parameter '%s' is an invalid block hash" s)

let group =
  {
    Tezos_clic.name = "context";
    title = "Block contextual commands (see option -block)";
  }

let alphanet = {Tezos_clic.name = "alphanet"; title = "Alphanet only commands"}

let binary_description =
  {Tezos_clic.name = "description"; title = "Binary Description"}

let transfer_command amount source destination (cctxt : #Client_context.printer)
    ( fee,
      dry_run,
      verbose_signing,
      simulation,
      force,
      gas_limit,
      storage_limit,
      counter,
      arg,
      no_print_source,
      minimal_fees,
      minimal_nanotez_per_byte,
      minimal_nanotez_per_gas_unit,
      force_low_fee,
      fee_cap,
      burn_cap,
      entrypoint ) =
  let fee_parameter =
    {
      Injection.minimal_fees;
      minimal_nanotez_per_byte;
      minimal_nanotez_per_gas_unit;
      force_low_fee;
      fee_cap;
      burn_cap;
    }
  in
  (* When --force is used we want to inject the transfer even if it fails.
     In that case we cannot rely on simulation to compute limits and fees
     so we require the corresponding options to be set. *)
  let check_force_dependency name = function
    | None ->
        cctxt#error
          "When the --force switch is used, the %s option is required."
          name
    | _ -> Lwt.return_unit
  in
  (if force then
   check_force_dependency "--gas-limit" gas_limit >>= fun () ->
   check_force_dependency "--storage-limit" storage_limit >>= fun () ->
   check_force_dependency "--fee" fee
  else Lwt.return_unit)
  >>= fun () ->
  (match Contract.is_implicit source with
  | None ->
      let contract = source in
      Managed_contract.get_contract_manager cctxt source >>=? fun source ->
      Client_keys_v0.get_key cctxt source >>=? fun (_, src_pk, src_sk) ->
      Managed_contract.transfer
        cctxt
        ~chain:cctxt#chain
        ~block:cctxt#block
        ?confirmations:cctxt#confirmations
        ~dry_run
        ~verbose_signing
        ~simulation
        ~force
        ~fee_parameter
        ?fee
        ~contract
        ~source
        ~src_pk
        ~src_sk
        ~destination
        ?entrypoint
        ?arg
        ~amount
        ?gas_limit
        ?storage_limit
        ?counter
        ()
  | Some source ->
      Client_keys_v0.get_key cctxt source >>=? fun (_, src_pk, src_sk) ->
      transfer
        cctxt
        ~chain:cctxt#chain
        ~block:cctxt#block
        ?confirmations:cctxt#confirmations
        ~dry_run
        ~simulation
        ~force
        ~verbose_signing
        ~fee_parameter
        ~source
        ?fee
        ~src_pk
        ~src_sk
        ~destination
        ?entrypoint
        ?arg
        ~amount
        ?gas_limit
        ?storage_limit
        ?counter
        ())
  >>= report_michelson_errors
        ~no_print_source
        ~msg:"transfer simulation failed"
        cctxt
  >>= function
  | None -> return_unit
  | Some (_res, _contracts) -> return_unit

let tez_of_string_exn index field s =
  match Tez.of_string s with
  | Some t -> return t
  | None ->
      failwith
        "Invalid \xEA\x9C\xA9 notation at entry %i, field \"%s\": %s"
        index
        field
        s

let tez_of_opt_string_exn index field s =
  match s with
  | None -> return None
  | Some s -> tez_of_string_exn index field s >>=? fun s -> return (Some s)

let prepare_batch_operation cctxt ?arg ?fee ?gas_limit ?storage_limit
    ?entrypoint source index batch =
  Client_proto_contracts.ContractAlias.find_destination cctxt batch.destination
  >>=? fun (_, destination) ->
  tez_of_string_exn index "amount" batch.amount >>=? fun amount ->
  tez_of_opt_string_exn index "fee" batch.fee >>=? fun batch_fee ->
  let fee = Option.either batch_fee fee in
  let arg = Option.either batch.arg arg in
  let gas_limit = Option.either batch.gas_limit gas_limit in
  let storage_limit = Option.either batch.storage_limit storage_limit in
  let entrypoint = Option.either batch.entrypoint entrypoint in
  parse_arg_transfer arg >>=? fun parameters ->
  (match Contract.is_implicit source with
  | None ->
      Managed_contract.build_transaction_operation
        cctxt
        ~chain:cctxt#chain
        ~block:cctxt#block
        ~contract:source
        ~destination
        ?entrypoint
        ?arg
        ~amount
        ?fee
        ?gas_limit
        ?storage_limit
        ()
  | Some _ ->
      return
        (build_transaction_operation
           ~amount
           ~parameters
           ?entrypoint
           ?fee
           ?gas_limit
           ?storage_limit
           destination))
  >>=? fun operation ->
  return (Annotated_manager_operation.Annotated_manager_operation operation)

let commands network () =
  let open Tezos_clic in
  [
    command
      ~group
      ~desc:"Access the timestamp of the block."
      (args1
         (switch ~doc:"output time in seconds" ~short:'s' ~long:"seconds" ()))
      (fixed ["get"; "timestamp"])
      (fun seconds (cctxt : Protocol_client_context.full) ->
        Shell_services.Blocks.Header.shell_header
          cctxt
          ~chain:cctxt#chain
          ~block:cctxt#block
          ()
        >>=? fun {timestamp = v; _} ->
        (if seconds then cctxt#message "%Ld" (Time.Protocol.to_seconds v)
        else cctxt#message "%s" (Time.Protocol.to_notation v))
        >>= fun () -> return_unit);
    command
      ~group
      ~desc:"Lists all non empty contracts of the block."
      no_options
      (fixed ["list"; "contracts"])
      (fun () (cctxt : Protocol_client_context.full) ->
        list_contract_labels cctxt ~chain:cctxt#chain ~block:cctxt#block
        >>=? fun contracts ->
        List.iter_s
          (fun (alias, hash, kind) -> cctxt#message "%s%s%s" hash kind alias)
          contracts
        >>= fun () -> return_unit);
    command
      ~group
      ~desc:"Lists cached contracts and their age in LRU ordering."
      no_options
      (prefixes ["list"; "cached"; "contracts"] @@ stop)
      (fun () (cctxt : Protocol_client_context.full) ->
        cached_contracts cctxt ~chain:cctxt#chain ~block:cctxt#block
        >>=? fun keys ->
        List.iter_s
          (fun (key, size) ->
            cctxt#message "%a %d" Alpha_context.Contract.pp key size)
          keys
        >>= fun () -> return_unit);
    command
      ~group
      ~desc:"Get the key rank of a cache key."
      no_options
      (prefixes ["get"; "cached"; "contract"; "rank"; "for"]
      @@ ContractAlias.destination_param ~name:"src" ~desc:"contract"
      @@ stop)
      (fun () (_, contract) (cctxt : Protocol_client_context.full) ->
        contract_rank cctxt ~chain:cctxt#chain ~block:cctxt#block contract
        >>=? fun rank ->
        match rank with
        | None ->
            cctxt#error
              "Invalid contract: %a"
              Alpha_context.Contract.pp
              contract
            >>= fun () -> return_unit
        | Some rank -> cctxt#message "%d" rank >>= fun () -> return_unit);
    command
      ~group
      ~desc:"Get cache contract size."
      no_options
      (prefixes ["get"; "cache"; "contract"; "size"] @@ stop)
      (fun () (cctxt : Protocol_client_context.full) ->
        contract_cache_size cctxt ~chain:cctxt#chain ~block:cctxt#block
        >>=? fun t ->
        cctxt#message "%d" t >>= fun () -> return_unit);
    command
      ~group
      ~desc:"Get cache contract size limit."
      no_options
      (prefixes ["get"; "cache"; "contract"; "size"; "limit"] @@ stop)
      (fun () (cctxt : Protocol_client_context.full) ->
        contract_cache_size_limit cctxt ~chain:cctxt#chain ~block:cctxt#block
        >>=? fun t ->
        cctxt#message "%d" t >>= fun () -> return_unit);
    command
      ~group
      ~desc:"Get the balance of a contract."
      no_options
      (prefixes ["get"; "balance"; "for"]
      @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
      @@ stop)
      (fun () (_, contract) (cctxt : Protocol_client_context.full) ->
        get_balance cctxt ~chain:cctxt#chain ~block:cctxt#block contract
        >>=? fun amount ->
        cctxt#answer "%a %s" Tez.pp amount Client_proto_args.tez_sym
        >>= fun () -> return_unit);
    command
      ~group
      ~desc:"Get the storage of a contract."
      (args1 (unparsing_mode_arg ~default:"Readable"))
      (prefixes ["get"; "contract"; "storage"; "for"]
      @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
      @@ stop)
      (fun unparsing_mode (_, contract) (cctxt : Protocol_client_context.full) ->
        get_storage
          cctxt
          ~chain:cctxt#chain
          ~block:cctxt#block
          ~unparsing_mode
          contract
        >>=? function
        | None -> cctxt#error "This is not a smart contract."
        | Some storage ->
            cctxt#answer "%a" Michelson_v1_printer.print_expr_unwrapped storage
            >>= fun () -> return_unit);
    command
      ~group
      ~desc:
        "Get the value associated to a key in the big map storage of a \
         contract (deprecated)."
      no_options
      (prefixes ["get"; "big"; "map"; "value"; "for"]
      @@ Tezos_clic.param ~name:"key" ~desc:"the key to look for" data_parameter
      @@ prefixes ["of"; "type"]
      @@ Tezos_clic.param ~name:"type" ~desc:"type of the key" data_parameter
      @@ prefix "in"
      @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
      @@ stop)
      (fun () key key_type (_, contract) (cctxt : Protocol_client_context.full) ->
        get_contract_big_map_value
          cctxt
          ~chain:cctxt#chain
          ~block:cctxt#block
          contract
          (key.expanded, key_type.expanded)
        >>=? function
        | None -> cctxt#error "No value associated to this key."
        | Some value ->
            cctxt#answer "%a" Michelson_v1_printer.print_expr_unwrapped value
            >>= fun () -> return_unit);
    command
      ~group
      ~desc:"Get a value in a big map."
      (args1 (unparsing_mode_arg ~default:"Readable"))
      (prefixes ["get"; "element"]
      @@ Tezos_clic.param
           ~name:"key"
           ~desc:"the key to look for"
           (Tezos_clic.parameter (fun _ s ->
                return (Script_expr_hash.of_b58check_exn s)))
      @@ prefixes ["of"; "big"; "map"]
      @@ Tezos_clic.param
           ~name:"big_map"
           ~desc:"identifier of the big_map"
           int_parameter
      @@ stop)
      (fun unparsing_mode key id (cctxt : Protocol_client_context.full) ->
        get_big_map_value
          cctxt
          ~chain:cctxt#chain
          ~block:cctxt#block
          ~unparsing_mode
          (Big_map.Id.parse_z (Z.of_int id))
          key
        >>=? fun value ->
        cctxt#answer "%a" Michelson_v1_printer.print_expr_unwrapped value
        >>= fun () -> return_unit);
    command
      ~group
      ~desc:"Get the code of a contract."
      (args1 (unparsing_mode_arg ~default:"Readable"))
      (prefixes ["get"; "contract"; "code"; "for"]
      @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
      @@ stop)
      (fun unparsing_mode (_, contract) (cctxt : Protocol_client_context.full) ->
        get_script
          cctxt
          ~chain:cctxt#chain
          ~block:cctxt#block
          ~unparsing_mode
          contract
        >>=? function
        | None -> cctxt#error "This is not a smart contract."
        | Some {code; storage = _} -> (
            match Script_repr.force_decode code with
            | Error errs ->
                cctxt#error "%a" Environment.Error_monad.pp_trace errs
            | Ok code ->
                let {Michelson_v1_parser.source; _} =
                  Michelson_v1_printer.unparse_toplevel code
                in
                cctxt#answer "%s" source >>= return));
    command
      ~group
      ~desc:"Get the `BLAKE2B` script hash of a contract."
      no_options
      (prefixes ["get"; "contract"; "script"; "hash"; "for"]
      @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
      @@ stop)
      (fun () (_, contract) (cctxt : Protocol_client_context.full) ->
        get_script_hash cctxt ~chain:cctxt#chain ~block:cctxt#block contract
        >>= function
        | Error trace -> cctxt#error "%a" pp_print_trace trace
        | Ok None -> cctxt#error "This is not a smart contract."
        | Ok (Some hash) -> cctxt#answer "%a" Script_expr_hash.pp hash >|= ok);
    command
      ~group
      ~desc:"Get the type of an entrypoint of a contract."
      no_options
      (prefixes ["get"; "contract"; "entrypoint"; "type"; "of"]
      @@ Tezos_clic.string ~name:"entrypoint" ~desc:"the entrypoint to describe"
      @@ prefixes ["for"]
      @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
      @@ stop)
      (fun () entrypoint (_, contract) (cctxt : Protocol_client_context.full) ->
        Michelson_v1_entrypoints.contract_entrypoint_type
          cctxt
          ~chain:cctxt#chain
          ~block:cctxt#block
          ~contract
          ~entrypoint
        >>= Michelson_v1_entrypoints.print_entrypoint_type
              cctxt
              ~emacs:false
              ~contract
              ~entrypoint);
    command
      ~group
      ~desc:"Get the entrypoint list of a contract."
      no_options
      (prefixes ["get"; "contract"; "entrypoints"; "for"]
      @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
      @@ stop)
      (fun () (_, contract) (cctxt : Protocol_client_context.full) ->
        Michelson_v1_entrypoints.list_contract_entrypoints
          cctxt
          ~chain:cctxt#chain
          ~block:cctxt#block
          ~contract
        >>= Michelson_v1_entrypoints.print_entrypoints_list
              cctxt
              ~emacs:false
              ~contract);
    command
      ~group
      ~desc:"Get the list of unreachable paths in a contract's parameter type."
      no_options
      (prefixes ["get"; "contract"; "unreachable"; "paths"; "for"]
      @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
      @@ stop)
      (fun () (_, contract) (cctxt : Protocol_client_context.full) ->
        Michelson_v1_entrypoints.list_contract_unreachables
          cctxt
          ~chain:cctxt#chain
          ~block:cctxt#block
          ~contract
        >>= Michelson_v1_entrypoints.print_unreachables
              cctxt
              ~emacs:false
              ~contract);
    command
      ~group
      ~desc:"Get the delegate of a contract."
      no_options
      (prefixes ["get"; "delegate"; "for"]
      @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
      @@ stop)
      (fun () (_, contract) (cctxt : Protocol_client_context.full) ->
        Client_proto_contracts.get_delegate
          cctxt
          ~chain:cctxt#chain
          ~block:cctxt#block
          contract
        >>=? function
        | None -> cctxt#message "none" >>= fun () -> return_unit
        | Some delegate ->
            Public_key_hash.rev_find cctxt delegate >>=? fun mn ->
            Public_key_hash.to_source delegate >>=? fun m ->
            cctxt#message
              "%s (%s)"
              m
              (match mn with None -> "unknown" | Some n -> "known as " ^ n)
            >>= fun () -> return_unit);
    command
      ~group
      ~desc:"Set the delegate of a contract."
      (args10
         fee_arg
         dry_run_switch
         verbose_signing_switch
         simulate_switch
         minimal_fees_arg
         minimal_nanotez_per_byte_arg
         minimal_nanotez_per_gas_unit_arg
         force_low_fee_arg
         fee_cap_arg
         burn_cap_arg)
      (prefixes ["set"; "delegate"; "for"]
      @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
      @@ prefix "to"
      @@ Public_key_hash.source_param
           ~name:"dlgt"
           ~desc:"new delegate of the contract"
      @@ stop)
      (fun ( fee,
             dry_run,
             verbose_signing,
             simulation,
             minimal_fees,
             minimal_nanotez_per_byte,
             minimal_nanotez_per_gas_unit,
             force_low_fee,
             fee_cap,
             burn_cap )
           (_, contract)
           delegate
           (cctxt : Protocol_client_context.full) ->
        let fee_parameter =
          {
            Injection.minimal_fees;
            minimal_nanotez_per_byte;
            minimal_nanotez_per_gas_unit;
            force_low_fee;
            fee_cap;
            burn_cap;
          }
        in
        match Contract.is_implicit contract with
        | None ->
            Managed_contract.get_contract_manager cctxt contract
            >>=? fun source ->
            Client_keys_v0.get_key cctxt source >>=? fun (_, src_pk, src_sk) ->
            Managed_contract.set_delegate
              cctxt
              ~chain:cctxt#chain
              ~block:cctxt#block
              ?confirmations:cctxt#confirmations
              ~dry_run
              ~verbose_signing
              ~simulation
              ~fee_parameter
              ?fee
              ~source
              ~src_pk
              ~src_sk
              contract
              (Some delegate)
            >>= fun errors ->
            report_michelson_errors
              ~no_print_source:true
              ~msg:"Setting delegate through entrypoints failed."
              cctxt
              errors
            >>= fun _ -> return_unit
        | Some mgr ->
            Client_keys_v0.get_key cctxt mgr >>=? fun (_, src_pk, manager_sk) ->
            set_delegate
              cctxt
              ~chain:cctxt#chain
              ~block:cctxt#block
              ?confirmations:cctxt#confirmations
              ~dry_run
              ~verbose_signing
              ~simulation
              ~fee_parameter
              ?fee
              mgr
              (Some delegate)
              ~src_pk
              ~manager_sk
            >>=? fun _ -> return_unit);
    command
      ~group
      ~desc:"Withdraw the delegate from a contract."
      (args9
         fee_arg
         dry_run_switch
         verbose_signing_switch
         minimal_fees_arg
         minimal_nanotez_per_byte_arg
         minimal_nanotez_per_gas_unit_arg
         force_low_fee_arg
         fee_cap_arg
         burn_cap_arg)
      (prefixes ["withdraw"; "delegate"; "from"]
      @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
      @@ stop)
      (fun ( fee,
             dry_run,
             verbose_signing,
             minimal_fees,
             minimal_nanotez_per_byte,
             minimal_nanotez_per_gas_unit,
             force_low_fee,
             fee_cap,
             burn_cap )
           (_, contract)
           (cctxt : Protocol_client_context.full) ->
        let fee_parameter =
          {
            Injection.minimal_fees;
            minimal_nanotez_per_byte;
            minimal_nanotez_per_gas_unit;
            force_low_fee;
            fee_cap;
            burn_cap;
          }
        in
        match Contract.is_implicit contract with
        | None ->
            Managed_contract.get_contract_manager cctxt contract
            >>=? fun source ->
            Client_keys_v0.get_key cctxt source >>=? fun (_, src_pk, src_sk) ->
            Managed_contract.set_delegate
              cctxt
              ~chain:cctxt#chain
              ~block:cctxt#block
              ?confirmations:cctxt#confirmations
              ~dry_run
              ~verbose_signing
              ~fee_parameter
              ?fee
              ~source
              ~src_pk
              ~src_sk
              contract
              None
            >>= fun errors ->
            report_michelson_errors
              ~no_print_source:true
              ~msg:"Withdrawing delegate through entrypoints failed."
              cctxt
              errors
            >>= fun _ -> return_unit
        | Some mgr ->
            Client_keys_v0.get_key cctxt mgr >>=? fun (_, src_pk, manager_sk) ->
            set_delegate
              cctxt
              ~chain:cctxt#chain
              ~block:cctxt#block
              ?confirmations:cctxt#confirmations
              ~dry_run
              ~verbose_signing
              ~fee_parameter
              mgr
              None
              ?fee
              ~src_pk
              ~manager_sk
            >>= fun _ -> return_unit);
    command
      ~group
      ~desc:"Launch a smart contract on the blockchain."
      (args15
         fee_arg
         dry_run_switch
         verbose_signing_switch
         gas_limit_arg
         storage_limit_arg
         delegate_arg
         (Client_keys_v0.force_switch ())
         init_arg
         no_print_source_flag
         minimal_fees_arg
         minimal_nanotez_per_byte_arg
         minimal_nanotez_per_gas_unit_arg
         force_low_fee_arg
         fee_cap_arg
         burn_cap_arg)
      (prefixes ["originate"; "contract"]
      @@ RawContractAlias.fresh_alias_param
           ~name:"new"
           ~desc:"name of the new contract"
      @@ prefix "transferring"
      @@ tez_param ~name:"qty" ~desc:"amount taken from source"
      @@ prefix "from"
      @@ ContractAlias.destination_param
           ~name:"src"
           ~desc:"name of the source contract"
      @@ prefix "running"
      @@ Program.source_param
           ~name:"prg"
           ~desc:
             "script of the account\n\
              Combine with -init if the storage type is not unit."
      @@ stop)
      (fun ( fee,
             dry_run,
             verbose_signing,
             gas_limit,
             storage_limit,
             delegate,
             force,
             initial_storage,
             no_print_source,
             minimal_fees,
             minimal_nanotez_per_byte,
             minimal_nanotez_per_gas_unit,
             force_low_fee,
             fee_cap,
             burn_cap )
           alias_name
           balance
           (_, source)
           program
           (cctxt : Protocol_client_context.full) ->
        RawContractAlias.of_fresh cctxt force alias_name >>=? fun alias_name ->
        Lwt.return (Micheline_parser.no_parsing_error program)
        >>=? fun {expanded = code; _} ->
        match Contract.is_implicit source with
        | None ->
            failwith
              "only implicit accounts can be the source of an origination"
        | Some source -> (
            Client_keys_v0.get_key cctxt source >>=? fun (_, src_pk, src_sk) ->
            let fee_parameter =
              {
                Injection.minimal_fees;
                minimal_nanotez_per_byte;
                minimal_nanotez_per_gas_unit;
                force_low_fee;
                fee_cap;
                burn_cap;
              }
            in
            originate_contract
              cctxt
              ~chain:cctxt#chain
              ~block:cctxt#block
              ?confirmations:cctxt#confirmations
              ~dry_run
              ~verbose_signing
              ?fee
              ?gas_limit
              ?storage_limit
              ~delegate
              ~initial_storage
              ~balance
              ~source
              ~src_pk
              ~src_sk
              ~code
              ~fee_parameter
              ()
            >>= fun errors ->
            report_michelson_errors
              ~no_print_source
              ~msg:"origination simulation failed"
              cctxt
              errors
            >>= function
            | None -> return_unit
            | Some (_res, contract) ->
                if dry_run then return_unit
                else
                  save_contract ~force cctxt alias_name contract >>=? fun () ->
                  return_unit));
    command
      ~group
      ~desc:
        "Execute multiple transfers from a single source account.\n\
         If one of the transfers fails, none of them get executed."
      (args16
         default_fee_arg
         dry_run_switch
         verbose_signing_switch
         simulate_switch
         default_gas_limit_arg
         default_storage_limit_arg
         counter_arg
         default_arg_arg
         no_print_source_flag
         minimal_fees_arg
         minimal_nanotez_per_byte_arg
         minimal_nanotez_per_gas_unit_arg
         force_low_fee_arg
         fee_cap_arg
         burn_cap_arg
         default_entrypoint_arg)
      (prefixes ["multiple"; "transfers"; "from"]
      @@ ContractAlias.destination_param
           ~name:"src"
           ~desc:"name of the source contract"
      @@ prefix "using"
      @@ param
           ~name:"transfers.json"
           ~desc:
             "List of operations originating from the source contract in JSON \
              format (from a file or directly inlined). The input JSON must be \
              an array of objects of the form: '[ {\"destination\": dst, \
              \"amount\": qty (, <field>: <val> ...) } (, ...) ]', where an \
              optional <field> can either be \"fee\", \"gas-limit\", \
              \"storage-limit\", \"arg\", or \"entrypoint\"."
           json_file_or_text_parameter
      @@ stop)
      (fun ( fee,
             dry_run,
             verbose_signing,
             simulation,
             gas_limit,
             storage_limit,
             counter,
             arg,
             no_print_source,
             minimal_fees,
             minimal_nanotez_per_byte,
             minimal_nanotez_per_gas_unit,
             force_low_fee,
             fee_cap,
             burn_cap,
             entrypoint )
           (_, source)
           operations_json
           cctxt ->
        let fee_parameter =
          {
            Injection.minimal_fees;
            minimal_nanotez_per_byte;
            minimal_nanotez_per_gas_unit;
            force_low_fee;
            fee_cap;
            burn_cap;
          }
        in
        let prepare i =
          prepare_batch_operation
            cctxt
            ?arg
            ?fee
            ?gas_limit
            ?storage_limit
            ?entrypoint
            source
            i
        in
        match
          Data_encoding.Json.destruct
            (Data_encoding.list
               Client_proto_context.batch_transfer_operation_encoding)
            operations_json
        with
        | [] -> failwith "Empty operation list"
        | operations ->
            (match Contract.is_implicit source with
            | None ->
                Managed_contract.get_contract_manager cctxt source
                >>=? fun source ->
                Client_keys_v0.get_key cctxt source
                >>=? fun (_, src_pk, src_sk) -> return (source, src_pk, src_sk)
            | Some source ->
                Client_keys_v0.get_key cctxt source
                >>=? fun (_, src_pk, src_sk) -> return (source, src_pk, src_sk))
            >>=? fun (source, src_pk, src_sk) ->
            List.mapi_ep prepare operations >>=? fun contents ->
            let (Manager_list contents) =
              Annotated_manager_operation.manager_of_list contents
            in
            Injection.inject_manager_operation
              cctxt
              ~chain:cctxt#chain
              ~block:cctxt#block
              ?confirmations:cctxt#confirmations
              ~dry_run
              ~verbose_signing
              ~simulation
              ~source
              ~fee:(Limit.of_option fee)
              ~gas_limit:(Limit.of_option gas_limit)
              ~storage_limit:(Limit.of_option storage_limit)
              ?counter
              ~src_pk
              ~src_sk
              ~fee_parameter
              contents
            >>= report_michelson_errors
                  ~no_print_source
                  ~msg:"multiple transfers simulation failed"
                  cctxt
            >>= fun _ -> return_unit
        | exception (Data_encoding.Json.Cannot_destruct (path, exn2) as exn)
          -> (
            match (path, operations_json) with
            | [`Index n], `A lj -> (
                match List.nth_opt lj n with
                | Some j ->
                    failwith
                      "Invalid transfer at index %i: %a %a"
                      n
                      (fun ppf -> Data_encoding.Json.print_error ppf)
                      exn2
                      Data_encoding.Json.pp
                      j
                | _ ->
                    failwith
                      "Invalid transfer at index %i: %a"
                      n
                      (fun ppf -> Data_encoding.Json.print_error ppf)
                      exn2)
            | _ ->
                failwith
                  "Invalid transfer file: %a %a"
                  (fun ppf -> Data_encoding.Json.print_error ppf)
                  exn
                  Data_encoding.Json.pp
                  operations_json));
    command
      ~group
      ~desc:"Transfer tokens / call a smart contract."
      (args17
         fee_arg
         dry_run_switch
         verbose_signing_switch
         simulate_switch
         force_switch
         gas_limit_arg
         storage_limit_arg
         counter_arg
         arg_arg
         no_print_source_flag
         minimal_fees_arg
         minimal_nanotez_per_byte_arg
         minimal_nanotez_per_gas_unit_arg
         force_low_fee_arg
         fee_cap_arg
         burn_cap_arg
         entrypoint_arg)
      (prefixes ["transfer"]
      @@ tez_param ~name:"qty" ~desc:"amount taken from source"
      @@ prefix "from"
      @@ ContractAlias.destination_param
           ~name:"src"
           ~desc:"name of the source contract"
      @@ prefix "to"
      @@ ContractAlias.destination_param
           ~name:"dst"
           ~desc:"name/literal of the destination contract"
      @@ stop)
      (fun ( fee,
             dry_run,
             verbose_signing,
             simulation,
             force,
             gas_limit,
             storage_limit,
             counter,
             arg,
             no_print_source,
             minimal_fees,
             minimal_nanotez_per_byte,
             minimal_nanotez_per_gas_unit,
             force_low_fee,
             fee_cap,
             burn_cap,
             entrypoint )
           amount
           (_, source)
           (_, destination)
           cctxt ->
        transfer_command
          amount
          source
          destination
          cctxt
          ( fee,
            dry_run,
            verbose_signing,
            simulation,
            force,
            gas_limit,
            storage_limit,
            counter,
            arg,
            no_print_source,
            minimal_fees,
            minimal_nanotez_per_byte,
            minimal_nanotez_per_gas_unit,
            force_low_fee,
            fee_cap,
            burn_cap,
            entrypoint ));
    command
      ~group
      ~desc:"Register a global constant"
      (args12
         fee_arg
         dry_run_switch
         verbose_signing_switch
         simulate_switch
         minimal_fees_arg
         minimal_nanotez_per_byte_arg
         minimal_nanotez_per_gas_unit_arg
         storage_limit_arg
         counter_arg
         force_low_fee_arg
         fee_cap_arg
         burn_cap_arg)
      (prefixes ["register"; "global"; "constant"]
      @@ global_constant_param
           ~name:"expression"
           ~desc:
             "Michelson expression to register. Note the value is not \
              typechecked before registration."
      @@ prefix "from"
      @@ ContractAlias.destination_param
           ~name:"src"
           ~desc:"name of the account registering the global constant"
      @@ stop)
      (fun ( fee,
             dry_run,
             verbose_signing,
             simulation,
             minimal_fees,
             minimal_nanotez_per_byte,
             minimal_nanotez_per_gas_unit,
             storage_limit,
             counter,
             force_low_fee,
             fee_cap,
             burn_cap )
           global_constant_str
           (_, source)
           cctxt ->
        match Contract.is_implicit source with
        | None ->
            failwith "Only implicit accounts can register global constants"
        | Some source ->
            Client_keys_v0.get_key cctxt source >>=? fun (_, src_pk, src_sk) ->
            let fee_parameter =
              {
                Injection.minimal_fees;
                minimal_nanotez_per_byte;
                minimal_nanotez_per_gas_unit;
                force_low_fee;
                fee_cap;
                burn_cap;
              }
            in
            register_global_constant
              cctxt
              ~chain:cctxt#chain
              ~block:cctxt#block
              ?dry_run:(Some dry_run)
              ?verbose_signing:(Some verbose_signing)
              ?fee
              ?storage_limit
              ?counter
              ?confirmations:cctxt#confirmations
              ~simulation
              ~source
              ~src_pk
              ~src_sk
              ~fee_parameter
              ~constant:global_constant_str
              ()
            >>= fun errors ->
            report_michelson_errors
              ~no_print_source:false
              ~msg:"register global constant simulation failed"
              cctxt
              errors
            >>= fun _ -> return_unit);
    command
      ~group
      ~desc:"Call a smart contract (same as 'transfer 0')."
      (args17
         fee_arg
         dry_run_switch
         verbose_signing_switch
         simulate_switch
         force_switch
         gas_limit_arg
         storage_limit_arg
         counter_arg
         arg_arg
         no_print_source_flag
         minimal_fees_arg
         minimal_nanotez_per_byte_arg
         minimal_nanotez_per_gas_unit_arg
         force_low_fee_arg
         fee_cap_arg
         burn_cap_arg
         entrypoint_arg)
      (prefixes ["call"]
      @@ ContractAlias.destination_param
           ~name:"dst"
           ~desc:"name/literal of the destination contract"
      @@ prefix "from"
      @@ ContractAlias.destination_param
           ~name:"src"
           ~desc:"name of the source contract"
      @@ stop)
      (fun ( fee,
             dry_run,
             verbose_signing,
             simulation,
             force,
             gas_limit,
             storage_limit,
             counter,
             arg,
             no_print_source,
             minimal_fees,
             minimal_nanotez_per_byte,
             minimal_nanotez_per_gas_unit,
             force_low_fee,
             fee_cap,
             burn_cap,
             entrypoint )
           (_, destination)
           (_, source)
           cctxt ->
        let amount = Tez.zero in
        transfer_command
          amount
          source
          destination
          cctxt
          ( fee,
            dry_run,
            verbose_signing,
            simulation,
            force,
            gas_limit,
            storage_limit,
            counter,
            arg,
            no_print_source,
            minimal_fees,
            minimal_nanotez_per_byte,
            minimal_nanotez_per_gas_unit,
            force_low_fee,
            fee_cap,
            burn_cap,
            entrypoint ));
    command
      ~group
      ~desc:"Reveal the public key of the contract manager."
      (args9
         fee_arg
         dry_run_switch
         verbose_signing_switch
         minimal_fees_arg
         minimal_nanotez_per_byte_arg
         minimal_nanotez_per_gas_unit_arg
         force_low_fee_arg
         fee_cap_arg
         burn_cap_arg)
      (prefixes ["reveal"; "key"; "for"]
      @@ ContractAlias.alias_param
           ~name:"src"
           ~desc:"name of the source contract"
      @@ stop)
      (fun ( fee,
             dry_run,
             verbose_signing,
             minimal_fees,
             minimal_nanotez_per_byte,
             minimal_nanotez_per_gas_unit,
             force_low_fee,
             fee_cap,
             burn_cap )
           (_, source)
           cctxt ->
        match Contract.is_implicit source with
        | None -> failwith "only implicit accounts can be revealed"
        | Some source ->
            Client_keys_v0.get_key cctxt source >>=? fun (_, src_pk, src_sk) ->
            let fee_parameter =
              {
                Injection.minimal_fees;
                minimal_nanotez_per_byte;
                minimal_nanotez_per_gas_unit;
                force_low_fee;
                fee_cap;
                burn_cap;
              }
            in
            reveal
              cctxt
              ~dry_run
              ~verbose_signing
              ~chain:cctxt#chain
              ~block:cctxt#block
              ?confirmations:cctxt#confirmations
              ~source
              ?fee
              ~src_pk
              ~src_sk
              ~fee_parameter
              ()
            >>=? fun _res -> return_unit);
    command
      ~group
      ~desc:"Register the public key hash as a delegate."
      (args9
         fee_arg
         dry_run_switch
         verbose_signing_switch
         minimal_fees_arg
         minimal_nanotez_per_byte_arg
         minimal_nanotez_per_gas_unit_arg
         force_low_fee_arg
         fee_cap_arg
         burn_cap_arg)
      (prefixes ["register"; "key"]
      @@ Public_key_hash.source_param ~name:"mgr" ~desc:"the delegate key"
      @@ prefixes ["as"; "delegate"]
      @@ stop)
      (fun ( fee,
             dry_run,
             verbose_signing,
             minimal_fees,
             minimal_nanotez_per_byte,
             minimal_nanotez_per_gas_unit,
             force_low_fee,
             fee_cap,
             burn_cap )
           src_pkh
           cctxt ->
        Client_keys_v0.get_key cctxt src_pkh >>=? fun (_, src_pk, src_sk) ->
        let fee_parameter =
          {
            Injection.minimal_fees;
            minimal_nanotez_per_byte;
            minimal_nanotez_per_gas_unit;
            force_low_fee;
            fee_cap;
            burn_cap;
          }
        in
        register_as_delegate
          cctxt
          ~chain:cctxt#chain
          ~block:cctxt#block
          ?confirmations:cctxt#confirmations
          ~dry_run
          ~fee_parameter
          ~verbose_signing
          ?fee
          ~manager_sk:src_sk
          src_pk
        >>= function
        | Ok _ -> return_unit
        | Error [Environment.Ecoproto_error Delegate_storage.Active_delegate] ->
            cctxt#message "Delegate already activated." >>= fun () ->
            return_unit
        | Error el -> Lwt.return_error el);
  ]
  @ (match network with
    | Some `Mainnet -> []
    | Some `Testnet | None ->
        [
          command
            ~group
            ~desc:"Register and activate an Alphanet/Zeronet faucet account."
            (args2 (Secret_key.force_switch ()) encrypted_switch)
            (prefixes ["activate"; "account"]
            @@ Secret_key.fresh_alias_param @@ prefixes ["with"]
            @@ param
                 ~name:"activation_key"
                 ~desc:
                   "Activate an Alphanet/Zeronet faucet account from the JSON \
                    (file or directly inlined)."
                 json_file_or_text_parameter
            @@ stop)
            (fun (force, encrypted) name activation_json cctxt ->
              Secret_key.of_fresh cctxt force name >>=? fun name ->
              match
                Data_encoding.Json.destruct
                  Client_proto_context.activation_key_encoding
                  activation_json
              with
              | exception (Data_encoding.Json.Cannot_destruct _ as exn) ->
                  Format.kasprintf
                    (fun s -> failwith "%s" s)
                    "Invalid activation file: %a %a"
                    (fun ppf -> Data_encoding.Json.print_error ppf)
                    exn
                    Data_encoding.Json.pp
                    activation_json
              | key ->
                  activate_account
                    cctxt
                    ~chain:cctxt#chain
                    ~block:cctxt#block
                    ?confirmations:cctxt#confirmations
                    ~encrypted
                    ~force
                    key
                    name
                  >>=? fun _res -> return_unit);
        ])
  @ (match network with
    | Some `Testnet | None -> []
    | Some `Mainnet ->
        [
          command
            ~group
            ~desc:"Activate a fundraiser account."
            (args1 dry_run_switch)
            (prefixes ["activate"; "fundraiser"; "account"]
            @@ Public_key_hash.alias_param @@ prefixes ["with"]
            @@ param
                 ~name:"code"
                 (Tezos_clic.parameter (fun _ctx code ->
                      protect (fun () ->
                          return
                            (Blinded_public_key_hash.activation_code_of_hex
                               code))))
                 ~desc:"Activation code obtained from the Tezos foundation."
            @@ stop)
            (fun dry_run (name, _pkh) code cctxt ->
              activate_existing_account
                cctxt
                ~chain:cctxt#chain
                ~block:cctxt#block
                ?confirmations:cctxt#confirmations
                ~dry_run
                name
                code
              >>=? fun _res -> return_unit);
        ])
  @ [
      command
        ~desc:"Wait until an operation is included in a block"
        (args3
           (default_arg
              ~long:"confirmations"
              ~placeholder:"num_blocks"
              ~doc:
                "wait until 'N' additional blocks after the operation appears \
                 in the considered chain"
              ~default:"0"
              non_negative_param)
           (default_arg
              ~long:"check-previous"
              ~placeholder:"num_blocks"
              ~doc:"number of previous blocks to check"
              ~default:"10"
              non_negative_param)
           (arg
              ~long:"branch"
              ~placeholder:"block_hash"
              ~doc:
                "hash of the oldest block where we should look for the \
                 operation"
              block_hash_param))
        (prefixes ["wait"; "for"]
        @@ param
             ~name:"operation"
             ~desc:"Operation to be included"
             (parameter (fun _ x ->
                  match Operation_hash.of_b58check_opt x with
                  | None ->
                      Error_monad.failwith "Invalid operation hash: '%s'" x
                  | Some hash -> return hash))
        @@ prefixes ["to"; "be"; "included"]
        @@ stop)
        (fun (confirmations, predecessors, branch)
             operation_hash
             (ctxt : Protocol_client_context.full) ->
          Client_confirmations.wait_for_operation_inclusion
            ctxt
            ~chain:ctxt#chain
            ~confirmations
            ~predecessors
            ?branch
            operation_hash
          >>=? fun _ -> return_unit);
      command
        ~desc:"Get receipt for past operation"
        (args1
           (default_arg
              ~long:"check-previous"
              ~placeholder:"num_blocks"
              ~doc:"number of previous blocks to check"
              ~default:"10"
              non_negative_param))
        (prefixes ["get"; "receipt"; "for"]
        @@ param
             ~name:"operation"
             ~desc:"Operation to be looked up"
             (parameter (fun _ x ->
                  match Operation_hash.of_b58check_opt x with
                  | None ->
                      Error_monad.failwith "Invalid operation hash: '%s'" x
                  | Some hash -> return hash))
        @@ stop)
        (fun predecessors operation_hash (ctxt : Protocol_client_context.full) ->
          display_receipt_for_operation
            ctxt
            ~chain:ctxt#chain
            ~predecessors
            operation_hash
          >>=? fun _ -> return_unit);
      command
        ~group:binary_description
        ~desc:"Describe unsigned block header"
        no_options
        (fixed ["describe"; "unsigned"; "block"; "header"])
        (fun () (cctxt : Protocol_client_context.full) ->
          cctxt#message
            "%a"
            Data_encoding.Binary_schema.pp
            (Data_encoding.Binary.describe
               Alpha_context.Block_header.unsigned_encoding)
          >>= fun () -> return_unit);
      command
        ~group:binary_description
        ~desc:"Describe unsigned operation"
        no_options
        (fixed ["describe"; "unsigned"; "operation"])
        (fun () (cctxt : Protocol_client_context.full) ->
          cctxt#message
            "%a"
            Data_encoding.Binary_schema.pp
            (Data_encoding.Binary.describe
               Alpha_context.Operation.unsigned_encoding)
          >>= fun () -> return_unit);
      command
        ~group
        ~desc:"Submit protocol proposals"
        (args3
           dry_run_switch
           verbose_signing_switch
           (switch
              ~doc:
                "Do not fail when the checks that try to prevent the user from \
                 shooting themselves in the foot do."
              ~long:"force"
              ()))
        (prefixes ["submit"; "proposals"; "for"]
        @@ ContractAlias.destination_param
             ~name:"delegate"
             ~desc:"the delegate who makes the proposal"
        @@ seq_of_param
             (param
                ~name:"proposal"
                ~desc:"the protocol hash proposal to be submitted"
                (parameter (fun _ x ->
                     match Protocol_hash.of_b58check_opt x with
                     | None ->
                         Error_monad.failwith "Invalid proposal hash: '%s'" x
                     | Some hash -> return hash))))
        (fun (dry_run, verbose_signing, force)
             (_name, source)
             proposals
             (cctxt : Protocol_client_context.full) ->
          match Contract.is_implicit source with
          | None -> failwith "only implicit accounts can submit proposals"
          | Some src_pkh -> (
              Client_keys_v0.get_key cctxt src_pkh
              >>=? fun (src_name, _src_pk, src_sk) ->
              get_period_info
              (* Find period info of the successor, because the operation will
                 be injected on the next block at the earliest *)
                ~successor:true
                ~chain:cctxt#chain
                ~block:cctxt#block
                cctxt
              >>=? fun info ->
              (match info.current_period_kind with
              | Proposal -> return_unit
              | _ -> cctxt#error "Not in a proposal period")
              >>=? fun () ->
              Shell_services.Protocol.list cctxt >>=? fun known_protos ->
              get_proposals ~chain:cctxt#chain ~block:cctxt#block cctxt
              >>=? fun known_proposals ->
              Alpha_services.Voting.listings cctxt (cctxt#chain, cctxt#block)
              >>=? fun listings ->
              (* for a proposal to be valid it must either a protocol that was already
                 proposed by somebody else or a protocol known by the node, because
                 the user is the first proposer and just injected it with
                 tezos-admin-client *)
              let check_proposals proposals : bool tzresult Lwt.t =
                let n = List.length proposals in
                let errors = ref [] in
                let error ppf =
                  Format.kasprintf (fun s -> errors := s :: !errors) ppf
                in
                if n = 0 then error "Empty proposal list." ;
                if n > Constants.max_proposals_per_delegate then
                  error
                    "Too many proposals: %d > %d."
                    n
                    Constants.max_proposals_per_delegate ;
                (match
                   Base.List.find_all_dups
                     ~compare:Protocol_hash.compare
                     proposals
                 with
                | [] -> ()
                | dups ->
                    error
                      "There %s: %a."
                      (if Compare.List_length_with.(dups = 1) then
                       "is a duplicate proposal"
                      else "are duplicate proposals")
                      Format.(
                        pp_print_list
                          ~pp_sep:(fun ppf () -> pp_print_string ppf ", ")
                          Protocol_hash.pp)
                      dups) ;
                List.iter
                  (fun (p : Protocol_hash.t) ->
                    if
                      List.mem ~equal:Protocol_hash.equal p known_protos
                      || Environment.Protocol_hash.Map.mem p known_proposals
                    then ()
                    else
                      error
                        "Protocol %a is not a known proposal."
                        Protocol_hash.pp
                        p)
                  proposals ;
                if
                  not
                    (List.exists
                       (fun (pkh, _) ->
                         Tezos_crypto.Signature.V0.Public_key_hash.equal
                           pkh
                           src_pkh)
                       listings)
                then
                  error
                    "Public-key-hash `%a` from account `%s` does not appear to \
                     have voting rights."
                    Tezos_crypto.Signature.V0.Public_key_hash.pp
                    src_pkh
                    src_name ;
                if !errors <> [] then
                  cctxt#message
                    "There %s with the submission:%t"
                    (if Compare.List_length_with.(!errors = 1) then
                     "is an issue"
                    else "are issues")
                    Format.(
                      fun ppf ->
                        pp_print_cut ppf () ;
                        pp_open_vbox ppf 0 ;
                        List.iter
                          (fun msg ->
                            pp_open_hovbox ppf 2 ;
                            pp_print_string ppf "* " ;
                            pp_print_text ppf msg ;
                            pp_close_box ppf () ;
                            pp_print_cut ppf ())
                          !errors ;
                        pp_close_box ppf ())
                  >>= fun () -> return_false
                else return_true
              in
              check_proposals proposals >>=? fun all_valid ->
              (if all_valid then cctxt#message "All proposals are valid."
              else if force then
                cctxt#message
                  "Some proposals are not valid, but `--force` was used."
              else cctxt#error "Submission failed because of invalid proposals.")
              >>= fun () ->
              submit_proposals
                ~dry_run
                ~verbose_signing
                cctxt
                ~chain:cctxt#chain
                ~block:cctxt#block
                ~src_sk
                src_pkh
                proposals
              >>= function
              | Ok _res -> return_unit
              | Error errs ->
                  (match errs with
                  | [
                   Unregistered_error
                     (`O [("kind", `String "generic"); ("error", `String msg)]);
                  ] ->
                      cctxt#message
                        "Error:@[<hov>@.%a@]"
                        Format.pp_print_text
                        (String.split_on_char ' ' msg
                        |> List.filter (function
                               | "" | "\n" -> false
                               | _ -> true)
                        |> String.concat " "
                        |> String.map (function '\n' | '\t' -> ' ' | c -> c))
                  | trace -> cctxt#message "Error:@ %a" pp_print_trace trace)
                  >>= fun () -> failwith "Failed to submit proposals"));
      command
        ~group
        ~desc:"Submit a ballot"
        (args2 verbose_signing_switch dry_run_switch)
        (prefixes ["submit"; "ballot"; "for"]
        @@ ContractAlias.destination_param
             ~name:"delegate"
             ~desc:"the delegate who votes"
        @@ param
             ~name:"proposal"
             ~desc:"the protocol hash proposal to vote for"
             (parameter (fun _ x ->
                  match Protocol_hash.of_b58check_opt x with
                  | None -> failwith "Invalid proposal hash: '%s'" x
                  | Some hash -> return hash))
        @@ param
             ~name:"ballot"
             ~desc:"the ballot value (yea/yay, nay, or pass)"
             (parameter
                ~autocomplete:(fun _ -> return ["yea"; "nay"; "pass"])
                (fun _ s ->
                  (* We should have [Vote.of_string]. *)
                  match String.lowercase_ascii s with
                  | "yay" | "yea" -> return Vote.Yay
                  | "nay" -> return Vote.Nay
                  | "pass" -> return Vote.Pass
                  | s -> failwith "Invalid ballot: '%s'" s))
        @@ stop)
        (fun (verbose_signing, dry_run)
             (_name, source)
             proposal
             ballot
             (cctxt : Protocol_client_context.full) ->
          match Contract.is_implicit source with
          | None -> failwith "only implicit accounts can submit ballot"
          | Some src_pkh ->
              Client_keys_v0.get_key cctxt src_pkh
              >>=? fun (_src_name, _src_pk, src_sk) ->
              get_period_info
              (* Find period info of the successor, because the operation will
                 be injected on the next block at the earliest *)
                ~successor:true
                ~chain:cctxt#chain
                ~block:cctxt#block
                cctxt
              >>=? fun info ->
              (match info.current_period_kind with
              | Exploration | Promotion -> return_unit
              | _ -> cctxt#error "Not in Exploration or Promotion period")
              >>=? fun () ->
              submit_ballot
                cctxt
                ~chain:cctxt#chain
                ~block:cctxt#block
                ~src_sk
                src_pkh
                ~verbose_signing
                ~dry_run
                proposal
                ballot
              >>=? fun _res -> return_unit);
      command
        ~group
        ~desc:"Summarize the current voting period"
        no_options
        (fixed ["show"; "voting"; "period"])
        (fun () (cctxt : Protocol_client_context.full) ->
          get_period_info ~chain:cctxt#chain ~block:cctxt#block cctxt
          >>=? fun info ->
          cctxt#message
            "Current period: %a\nBlocks remaining until end of period: %ld"
            Data_encoding.Json.pp
            (Data_encoding.Json.construct
               Alpha_context.Voting_period.kind_encoding
               info.current_period_kind)
            info.remaining
          >>= fun () ->
          Shell_services.Protocol.list cctxt >>=? fun known_protos ->
          get_proposals ~chain:cctxt#chain ~block:cctxt#block cctxt
          >>=? fun props ->
          let ranks =
            Environment.Protocol_hash.Map.bindings props
            |> List.sort (fun (_, v1) (_, v2) -> Int32.(compare v2 v1))
          in
          let print_proposal = function
            | None ->
                cctxt#message "The current proposal has already been cleared."
            (* The proposal is cleared on the last block of adoption period, and
               also on the last block of the exploration and promotion
               periods when the proposal is not approved *)
            | Some proposal ->
                cctxt#message "Current proposal: %a" Protocol_hash.pp proposal
          in
          match info.current_period_kind with
          | Proposal ->
              (* the current proposals are cleared on the last block of the
                 proposal period *)
              if info.remaining <> 0l then
                cctxt#answer
                  "Current proposals:%t"
                  Format.(
                    fun ppf ->
                      pp_print_cut ppf () ;
                      pp_open_vbox ppf 0 ;
                      List.iter
                        (fun (p, w) ->
                          fprintf
                            ppf
                            "* %a %ld (%sknown by the node)@."
                            Protocol_hash.pp
                            p
                            w
                            (if
                             List.mem ~equal:Protocol_hash.equal p known_protos
                            then ""
                            else "not "))
                        ranks ;
                      pp_close_box ppf ())
                >>= fun () -> return_unit
              else
                cctxt#message "The proposals have already been cleared."
                >>= fun () -> return_unit
          | Exploration | Promotion ->
              print_proposal info.current_proposal >>= fun () ->
              (* the ballots are cleared on the last block of these periods *)
              if info.remaining <> 0l then
                get_ballots_info ~chain:cctxt#chain ~block:cctxt#block cctxt
                >>=? fun ballots_info ->
                cctxt#answer
                  "Ballots: %a@,\
                   Current participation %.2f%%, necessary quorum %.2f%%@,\
                   Current in favor %ld, needed supermajority %ld"
                  Data_encoding.Json.pp
                  (Data_encoding.Json.construct
                     Vote.ballots_encoding
                     ballots_info.ballots)
                  (Int32.to_float ballots_info.participation /. 100.)
                  (Int32.to_float ballots_info.current_quorum /. 100.)
                  ballots_info.ballots.yay
                  ballots_info.supermajority
                >>= fun () -> return_unit
              else
                cctxt#message "The ballots have already been cleared."
                >>= fun () -> return_unit
          | Cooldown ->
              print_proposal info.current_proposal >>= fun () -> return_unit
          | Adoption ->
              print_proposal info.current_proposal >>= fun () -> return_unit);
    ]