ligo/src/client/embedded/bootstrap/client_proto_context.ml

(**************************************************************************)
(*                                                                        *)
(*    Copyright (c) 2014 - 2016.                                          *)
(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
(*                                                                        *)
(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
(*                                                                        *)
(**************************************************************************)

open Client_proto_args
open Client_proto_contracts
open Client_proto_programs
open Client_keys
module Ed25519 = Environment.Ed25519

let check_contract cctxt neu =
  RawContractAlias.mem cctxt neu >>= function
  | true ->
      cctxt.error "contract '%s' already exists" neu
  | false ->
      Lwt.return ()

let get_delegate_pkh cctxt = function
  | None -> Lwt.return None
  | Some delegate ->
      Lwt.catch
        (fun () ->
           Public_key_hash.find cctxt delegate >>= fun r ->
           Lwt.return (Some r))
        (fun _ -> Lwt.return None)

let get_timestamp cctxt block =
  Client_node_rpcs.Blocks.timestamp cctxt block >>= fun v ->
  cctxt.message "%s" (Time.to_notation v)

let list_contracts cctxt block =
  Client_proto_rpcs.Context.Contract.list cctxt block >>=? fun contracts ->
  iter_s (fun h ->
      begin match Contract.is_default h with
        | Some m -> begin
            Public_key_hash.rev_find cctxt m >>= function
            | None -> Lwt.return ""
            | Some nm ->
                RawContractAlias.find_opt cctxt nm >|= function
                | None -> " (known as " ^ nm ^ ")"
                | Some _ -> " (known as key:" ^ nm ^ ")"
          end
        | None -> begin
            RawContractAlias.rev_find cctxt h >|= function
            | None -> ""
            | Some nm ->  " (known as " ^ nm ^ ")"
          end
      end >>= fun nm ->
      let kind = match Contract.is_default h with
        | Some _ -> " (default)"
        | None -> "" in
      cctxt.message "%s%s%s" (Contract.to_b48check h) kind nm >>= fun () ->
      return ())
    contracts

let transfer cctxt
    block ?force
    ~source ~src_pk ~src_sk ~destination ?arg ~amount ~fee () =
  let open Cli_entries in
  Client_node_rpcs.Blocks.net cctxt block >>= fun net ->
  begin match arg with
    | Some arg ->
        Client_proto_programs.parse_data cctxt arg >>= fun arg ->
        Lwt.return (Some arg)
    | None -> Lwt.return None
  end >>= fun parameters ->
  Client_proto_rpcs.Context.Contract.counter cctxt block source >>=? fun pcounter ->
  let counter = Int32.succ pcounter in
  cctxt.message "Acquired the source's sequence counter (%ld -> %ld)."
    pcounter counter >>= fun () ->
  Client_proto_rpcs.Helpers.Forge.Manager.transaction cctxt block
    ~net ~source ~sourcePubKey:src_pk ~counter ~amount
    ~destination ?parameters ~fee () >>=? fun bytes ->
  cctxt.message "Forged the raw transaction frame." >>= fun () ->
  let signed_bytes = Ed25519.append_signature src_sk bytes in
  Client_node_rpcs.inject_operation cctxt ?force ~wait:true signed_bytes >>=? fun oph ->
  cctxt.answer "Operation successfully injected in the node." >>= fun () ->
  cctxt.answer "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
  return ()

let originate_account cctxt
    block ?force
    ~source ~src_pk ~src_sk ~manager_pkh ?delegatable ?spendable ?delegate ~balance ~fee () =
  let open Cli_entries in
  Client_node_rpcs.Blocks.net cctxt block >>= fun net ->
  Client_proto_rpcs.Context.Contract.counter cctxt block source >>=? fun pcounter ->
  let counter = Int32.succ pcounter in
  cctxt.message "Acquired the source's sequence counter (%ld -> %ld)."
    pcounter counter >>= fun () ->
  Client_proto_rpcs.Helpers.Forge.Manager.origination cctxt block
    ~net ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh
    ~counter ~balance ?spendable
    ?delegatable ?delegatePubKey:delegate ~fee () >>=? fun (contract, bytes) ->
  cctxt.message "Forged the raw origination frame." >>= fun () ->
  let signed_bytes = Ed25519.append_signature src_sk bytes in
  Client_node_rpcs.inject_operation cctxt ?force ~wait:true signed_bytes >>=? fun oph ->
  cctxt.message "Operation successfully injected in the node." >>= fun () ->
  cctxt.message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
  return contract

let originate_contract cctxt
    block ?force
    ~source ~src_pk ~src_sk ~manager_pkh ~balance ?delegatable ?delegatePubKey
    ~(code:Script.code) ~init ~fee () =
  let open Cli_entries in
  Client_proto_programs.parse_data cctxt init >>= fun storage ->
  let init = Script.{ storage ; storage_type = code.storage_type } in
  Client_proto_rpcs.Context.Contract.counter cctxt block source >>=? fun pcounter ->
  let counter = Int32.succ pcounter in
  cctxt.message "Acquired the source's sequence counter (%ld -> %ld)."
    pcounter counter >>= fun () ->
  Client_node_rpcs.Blocks.net cctxt block >>= fun net ->
  Client_proto_rpcs.Helpers.Forge.Manager.origination cctxt block
    ~net ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh
    ~counter ~balance ~spendable:!spendable
    ?delegatable ?delegatePubKey
    ~script:(code, init) ~fee () >>=? fun (contract, bytes) ->
  cctxt.message "Forged the raw origination frame." >>= fun () ->
  let signed_bytes = Ed25519.append_signature src_sk bytes in
  Client_node_rpcs.inject_operation cctxt ?force ~wait:true signed_bytes >>=? fun oph ->
  cctxt.message "Operation successfully injected in the node." >>= fun () ->
  cctxt.message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
  return contract

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

let commands () =
  let open Cli_entries in
  [ command ~group ~desc: "access the timestamp of the block"
      (fixed [ "get" ; "timestamp" ])
      (fun cctxt -> get_timestamp cctxt (block ())) ;
    command ~group ~desc: "lists all non empty contracts of the block"
      (fixed [ "list" ; "contracts" ])
      (fun cctxt ->
         list_contracts cctxt (block ()) >>= fun res ->
         Client_proto_rpcs.handle_error cctxt res) ;
    command ~group ~desc: "get the bootstrap keys and bootstrap contract handle"
      (fixed [ "bootstrap" ])
      (fun cctxt ->
         Client_proto_rpcs.Constants.bootstrap cctxt `Genesis >>= fun accounts ->
         let cpt = ref 0 in
         Lwt_list.iter_s
           (fun { Bootstrap.public_key_hash = pkh ;
                  public_key = pk ; secret_key = sk } ->
             incr cpt ;
             let name = Printf.sprintf "bootstrap%d" !cpt in
             Public_key_hash.add cctxt name pkh >>= fun () ->
             Public_key.add cctxt name pk >>= fun () ->
             Secret_key.add cctxt name sk >>= fun () ->
             cctxt.message "Bootstrap keys added under the name '%s'." name)
           accounts >>= fun () ->
         Lwt.return_unit) ;
    command ~group ~desc: "get the balance of a contract"
      (prefixes [ "get" ; "balance" ]
       @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
       @@ stop)
      (fun (_, contract) cctxt ->
         Client_proto_rpcs.Context.Contract.balance cctxt (block ()) contract
         >>= Client_proto_rpcs.handle_error cctxt >>= fun amount ->
         cctxt.answer "%a %s" Tez.pp amount tez_sym);
    command ~group ~desc: "get the manager of a block"
      (prefixes [ "get" ; "manager" ]
       @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
       @@ stop)
      (fun (_, contract) cctxt ->
         Client_proto_rpcs.Context.Contract.manager cctxt (block ()) contract
         >>= Client_proto_rpcs.handle_error cctxt >>= fun manager ->
         Public_key_hash.rev_find cctxt manager >>= fun mn ->
         Public_key_hash.to_source cctxt manager >>= fun m ->
         cctxt.message "%s (%s)" m
           (match mn with None -> "unknown" | Some n -> "known as " ^ n));
    command ~group ~desc: "open a new account"
      ~args: ([ fee_arg ; delegate_arg ; force_arg ]
              @ delegatable_args @ spendable_args)
      (prefixes [ "originate" ; "account" ]
       @@ RawContractAlias.fresh_alias_param
         ~name: "new" ~desc: "name of the new contract"
       @@ prefix "for"
       @@ Public_key_hash.alias_param
         ~name: "mgr" ~desc: "manager of the new contract"
       @@ prefix "transfering"
       @@ tez_param
         ~name: "qty" ~desc: "amount taken from source"
       @@ prefix "from"
       @@ ContractAlias.alias_param
         ~name:"src" ~desc: "name of the source contract"
       @@ stop)
      (fun neu (_, manager) balance (_, source) cctxt ->
         check_contract cctxt neu >>= fun () ->
         get_delegate_pkh cctxt !delegate >>= fun delegate ->
         (Client_proto_contracts.get_manager cctxt (block ()) source >>=? fun src_pkh ->
          Client_keys.get_key cctxt src_pkh >>=? fun (src_name, src_pk, src_sk) ->
          cctxt.message "Got the source's manager keys (%s)." src_name >>= fun () ->
          originate_account cctxt (block ()) ~force:!force
            ~source ~src_pk ~src_sk ~manager_pkh:manager ~balance ~fee:!fee
            ~delegatable:!delegatable ~spendable:!spendable ?delegate:delegate
            ()) >>= Client_proto_rpcs.handle_error cctxt >>= fun contract ->
         RawContractAlias.add cctxt neu contract) ;
    command ~group ~desc: "open a new scripted account"
      ~args: ([ fee_arg ; delegate_arg ; force_arg ] @
              delegatable_args @ spendable_args @ [ init_arg ])
      (prefixes [ "originate" ; "contract" ]
       @@ RawContractAlias.fresh_alias_param
         ~name: "new" ~desc: "name of the new contract"
       @@ prefix "for"
       @@ Public_key_hash.alias_param
         ~name: "mgr" ~desc: "manager of the new contract"
       @@ prefix "transfering"
       @@ tez_param
         ~name: "qty" ~desc: "amount taken from source"
       @@ prefix "from"
       @@ ContractAlias.alias_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 non void"
       @@ stop)
      (fun neu (_, manager) balance (_, source) code cctxt ->
         check_contract cctxt neu >>= fun () ->
         get_delegate_pkh cctxt !delegate >>= fun delegate ->
         (Client_proto_contracts.get_manager cctxt (block ()) source >>=? fun src_pkh ->
          Client_keys.get_key cctxt src_pkh >>=? fun (src_name, src_pk, src_sk) ->
          cctxt.message "Got the source's manager keys (%s)." src_name >>= fun () ->
          originate_contract cctxt (block ()) ~force:!force
            ~source ~src_pk ~src_sk ~manager_pkh:manager ~balance ~fee:!fee
            ~delegatable:!delegatable ?delegatePubKey:delegate ~code ~init:!init
            ()) >>= Client_proto_rpcs.handle_error cctxt >>= fun contract ->
         RawContractAlias.add cctxt neu contract) ;
    command ~group ~desc: "transfer tokens"
      ~args: [ fee_arg ; arg_arg ; force_arg ]
      (prefixes [ "transfer" ]
       @@ tez_param
         ~name: "qty" ~desc: "amount taken from source"
       @@ prefix "from"
       @@ ContractAlias.alias_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 amount (_, source) (_, destination) cctxt ->
         (Client_proto_contracts.get_manager cctxt (block ()) source >>=? fun src_pkh ->
         Client_keys.get_key cctxt src_pkh >>=? fun (src_name, src_pk, src_sk) ->
         cctxt.message "Got the source's manager keys (%s)." src_name >>= fun () ->
         transfer cctxt (block ()) ~force:!force
           ~source ~src_pk ~src_sk ~destination ?arg:!arg ~amount ~fee:!fee ()) >>=
         Client_proto_rpcs.handle_error cctxt)
  ]