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 handle_error f () =
    f () >>= Client_proto_rpcs.handle_error

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

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

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

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

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

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

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

let commands () =
  let open Cli_entries in
  register_group "context" "Block contextual commands (see option -block)" ;
  [ command
      ~group: "context"
      ~desc: "access the timestamp of the block"
      (fixed [ "get" ; "timestamp" ])
      (get_timestamp (block ())) ;
    command
      ~group: "context"
      ~desc: "lists all non empty contracts of the block"
      (fixed [ "list" ; "contracts" ])
      (handle_error (list_contracts (block ()))) ;
    command
      ~group: "context"
      ~desc: "get the bootstrap keys and bootstrap contract handle"
      (fixed [ "bootstrap" ])
      (fun () ->
         Client_proto_rpcs.Constants.bootstrap `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 name pkh >>= fun () ->
             Public_key.add name pk >>= fun () ->
             Secret_key.add name sk >>= fun () ->
             message "Bootstrap keys added under the name '%s'." name;
             Lwt.return_unit)
           accounts >>= fun () ->
         Lwt.return_unit) ;
    command
      ~group: "context"
      ~desc: "get the balance of a contract"
      (prefixes [ "get" ; "balance" ]
       @@ ContractAlias.destination_param ~n:"src" ~desc:"source contract"
       @@ stop)
      (fun (_, contract) () ->
         Client_proto_rpcs.Context.Contract.balance (block ()) contract
         >>= Client_proto_rpcs.handle_error >>= fun amount ->
         answer "%a %s" Tez.pp amount tez_sym;
         Lwt.return ());
    command
      ~group: "context"
      ~desc: "get the manager of a block"
      (prefixes [ "get" ; "manager" ]
       @@ ContractAlias.destination_param ~n:"src" ~desc:"source contract"
       @@ stop)
      (fun (_, contract) () ->
         Client_proto_rpcs.Context.Contract.manager (block ()) contract
         >>= Client_proto_rpcs.handle_error >>= fun manager ->
         Public_key_hash.rev_find manager >>= fun mn ->
         Public_key_hash.to_source manager >>= fun m ->
         message "%s (%s)" m
           (match mn with None -> "unknown" | Some n -> "known as " ^ n) ;
         Lwt.return ());
    command
      ~group: "context"
      ~desc: "open a new account"
      ~args: ([ fee_arg ; delegate_arg ; force_arg ]
              @ delegatable_args @ spendable_args)
      (prefixes [ "originate" ; "account" ]
       @@ RawContractAlias.fresh_alias_param
         ~n: "new" ~desc: "name of the new contract"
       @@ prefix "for"
       @@ Public_key_hash.alias_param
         ~n: "mgr" ~desc: "manager of the new contract"
       @@ prefix "transfering"
       @@ tez_param
         ~n: "qty" ~desc: "amount taken from source"
       @@ prefix "from"
       @@ ContractAlias.alias_param
         ~n:"src" ~desc: "name of the source contract"
       @@ stop)
      (fun neu (_, manager) balance (_, source) ->
         handle_error @@ fun () ->
         check_contract neu >>= fun () ->
         get_delegate_pkh !delegate >>= fun delegate ->
         Client_proto_contracts.get_manager (block ()) source >>=? fun src_pkh ->
         Client_keys.get_key src_pkh >>=? fun (src_name, src_pk, src_sk) ->
         message "Got the source's manager keys (%s)." src_name ;
         originate_account (block ()) ~force:!force
           ~source ~src_pk ~src_sk ~manager_pkh:manager ~balance ~fee:!fee
           ~delegatable:!delegatable ~spendable:!spendable ?delegate:delegate
           () >>=? fun contract ->
         RawContractAlias.add neu contract >>= fun () ->
         return ()) ;
    command
      ~group: "context"
      ~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
         ~n: "new" ~desc: "name of the new contract"
       @@ prefix "for"
       @@ Public_key_hash.alias_param
         ~n: "mgr" ~desc: "manager of the new contract"
       @@ prefix "transfering"
       @@ tez_param
         ~n: "qty" ~desc: "amount taken from source"
       @@ prefix "from"
       @@ ContractAlias.alias_param
         ~n:"src" ~desc: "name of the source contract"
       @@ prefix "running"
       @@ Program.source_param
         ~n:"prg" ~desc: "script of the account\n\
                          combine with -init if the storage type is non void"
       @@ stop)
      (fun neu (_, manager) balance (_, source) code ->
         handle_error @@ fun () ->
         check_contract neu >>= fun () ->
         get_delegate_pkh !delegate >>= fun delegate ->
         Client_proto_contracts.get_manager (block ()) source >>=? fun src_pkh ->
         Client_keys.get_key src_pkh >>=? fun (src_name, src_pk, src_sk) ->
         message "Got the source's manager keys (%s)." src_name ;
         originate_contract (block ()) ~force:!force
           ~source ~src_pk ~src_sk ~manager_pkh:manager ~balance ~fee:!fee
           ~delegatable:!delegatable ?delegatePubKey:delegate ~code ~init:!init ()
         >>=? fun contract ->
         RawContractAlias.add neu contract >>= fun () ->
         return ()) ;
    command
      ~group: "context"
      ~desc: "transfer tokens"
      ~args: [ fee_arg ; arg_arg ; force_arg ]
      (prefixes [ "transfer" ]
       @@ tez_param
         ~n: "qty" ~desc: "amount taken from source"
       @@ prefix "from"
       @@ ContractAlias.alias_param
         ~n: "src" ~desc: "name of the source contract"
       @@ prefix "to"
       @@ ContractAlias.destination_param
         ~n: "dst" ~desc: "name/literal of the destination contract"
       @@ stop)
      (fun amount (_, source) (_, destination) ->
         handle_error @@ fun () ->
         Client_proto_contracts.get_manager (block ()) source >>=? fun src_pkh ->
         Client_keys.get_key src_pkh >>=? fun (src_name, src_pk, src_sk) ->
         message "Got the source's manager keys (%s)." src_name ;
         transfer (block ()) ~force:!force
           ~source ~src_pk ~src_sk ~destination ?arg:!arg ~amount ~fee:!fee ())
  ]