257 lines
12 KiB
OCaml
257 lines
12 KiB
OCaml
(**************************************************************************)
|
|
(* *)
|
|
(* 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)
|
|
]
|