499 lines
20 KiB
OCaml
499 lines
20 KiB
OCaml
(**************************************************************************)
|
|
(* *)
|
|
(* Copyright (c) 2014 - 2017. *)
|
|
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
|
|
(* *)
|
|
(* All rights reserved. No warranty, explicit or implicit, provided. *)
|
|
(* *)
|
|
(**************************************************************************)
|
|
|
|
open Tezos_micheline
|
|
open Client_proto_args
|
|
open Client_proto_contracts
|
|
open Client_proto_programs
|
|
open Client_keys
|
|
open Client_commands
|
|
|
|
let get_balance cctxt block contract =
|
|
Client_proto_rpcs.Context.Contract.balance cctxt block contract
|
|
|
|
let get_storage cctxt block contract =
|
|
Client_proto_rpcs.Context.Contract.storage cctxt block contract
|
|
|
|
let rec find_predecessor rpc_config h n =
|
|
if n <= 0 then
|
|
return (`Hash h)
|
|
else
|
|
Client_node_rpcs.Blocks.predecessor rpc_config (`Hash h) >>=? fun h ->
|
|
find_predecessor rpc_config h (n-1)
|
|
|
|
let get_branch rpc_config block branch =
|
|
let branch = Option.unopt ~default:0 branch in (* TODO export parameter *)
|
|
let block = Client_rpcs.last_baked_block block in
|
|
begin
|
|
match block with
|
|
| `Head n -> return (`Head (n+branch))
|
|
| `Test_head n -> return (`Test_head (n+branch))
|
|
| `Hash h -> find_predecessor rpc_config h branch
|
|
| `Genesis -> return `Genesis
|
|
end >>=? fun block ->
|
|
Client_node_rpcs.Blocks.info rpc_config block >>=? fun { net_id ; hash } ->
|
|
return (net_id, hash)
|
|
|
|
let parse_expression arg =
|
|
Lwt.return
|
|
(Micheline_parser.no_parsing_error
|
|
(Michelson_v1_parser.parse_expression arg))
|
|
|
|
let transfer rpc_config
|
|
block ?force ?branch
|
|
~source ~src_pk ~src_sk ~destination ?arg ~amount ~fee () =
|
|
get_branch rpc_config block branch >>=? fun (net_id, branch) ->
|
|
begin match arg with
|
|
| Some arg ->
|
|
parse_expression arg >>=? fun { expanded = arg } ->
|
|
return (Some arg)
|
|
| None -> return None
|
|
end >>=? fun parameters ->
|
|
Client_proto_rpcs.Context.Contract.counter
|
|
rpc_config block source >>=? fun pcounter ->
|
|
let counter = Int32.succ pcounter in
|
|
Client_proto_rpcs.Helpers.Forge.Manager.transaction
|
|
rpc_config block
|
|
~branch ~source ~sourcePubKey:src_pk ~counter ~amount
|
|
~destination ?parameters ~fee () >>=? fun bytes ->
|
|
Client_node_rpcs.Blocks.predecessor rpc_config block >>=? fun predecessor ->
|
|
let signature = Ed25519.sign src_sk bytes in
|
|
let signed_bytes = Ed25519.Signature.concat bytes signature in
|
|
let oph = Operation_hash.hash_bytes [ signed_bytes ] in
|
|
Client_proto_rpcs.Helpers.apply_operation rpc_config block
|
|
predecessor oph bytes (Some signature) >>=? fun contracts ->
|
|
Client_node_rpcs.inject_operation
|
|
rpc_config ?force ~net_id signed_bytes >>=? fun injected_oph ->
|
|
assert (Operation_hash.equal oph injected_oph) ;
|
|
return (oph, contracts)
|
|
|
|
let originate rpc_config ?force ?net_id ~block ?signature bytes =
|
|
let signed_bytes =
|
|
match signature with
|
|
| None -> bytes
|
|
| Some signature -> Ed25519.Signature.concat bytes signature in
|
|
Client_node_rpcs.Blocks.predecessor rpc_config block >>=? fun predecessor ->
|
|
let oph = Operation_hash.hash_bytes [ signed_bytes ] in
|
|
Client_proto_rpcs.Helpers.apply_operation rpc_config block
|
|
predecessor oph bytes signature >>=? function
|
|
| [ contract ] ->
|
|
Client_node_rpcs.inject_operation
|
|
rpc_config ?force ?net_id signed_bytes >>=? fun injected_oph ->
|
|
assert (Operation_hash.equal oph injected_oph) ;
|
|
return (oph, contract)
|
|
| contracts ->
|
|
failwith
|
|
"The origination introduced %d contracts instead of one."
|
|
(List.length contracts)
|
|
|
|
let originate_account rpc_config
|
|
block ?force ?branch
|
|
~source ~src_pk ~src_sk ~manager_pkh
|
|
?delegatable ?spendable ?delegate ~balance ~fee () =
|
|
get_branch rpc_config block branch >>=? fun (net_id, branch) ->
|
|
Client_proto_rpcs.Context.Contract.counter
|
|
rpc_config block source >>=? fun pcounter ->
|
|
let counter = Int32.succ pcounter in
|
|
Client_proto_rpcs.Helpers.Forge.Manager.origination rpc_config block
|
|
~branch ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh
|
|
~counter ~balance ?spendable
|
|
?delegatable ?delegatePubKey:delegate ~fee () >>=? fun bytes ->
|
|
let signature = Ed25519.sign src_sk bytes in
|
|
originate rpc_config ?force ~block ~net_id ~signature bytes
|
|
|
|
let originate_contract rpc_config
|
|
block ?force ?branch
|
|
~source ~src_pk ~src_sk ~manager_pkh ~balance ?delegatable ?delegatePubKey
|
|
~code ~init ~fee ~spendable () =
|
|
parse_expression init >>=? fun { expanded = storage } ->
|
|
Client_proto_rpcs.Context.Contract.counter
|
|
rpc_config block source >>=? fun pcounter ->
|
|
let counter = Int32.succ pcounter in
|
|
get_branch rpc_config block branch >>=? fun (net_id, branch) ->
|
|
Client_proto_rpcs.Helpers.Forge.Manager.origination rpc_config block
|
|
~branch ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh
|
|
~counter ~balance ~spendable:spendable
|
|
?delegatable ?delegatePubKey
|
|
~script:{ code ; storage } ~fee () >>=? fun bytes ->
|
|
let signature = Ed25519.sign src_sk bytes in
|
|
originate rpc_config ?force ~net_id ~block ~signature bytes
|
|
|
|
let faucet rpc_config block ?force ?branch ~manager_pkh () =
|
|
get_branch rpc_config block branch >>=? fun (net_id, branch) ->
|
|
Client_proto_rpcs.Helpers.Forge.Anonymous.faucet
|
|
rpc_config block ~branch ~id:manager_pkh () >>=? fun bytes ->
|
|
originate rpc_config ?force ~net_id ~block bytes
|
|
|
|
let delegate_contract rpc_config
|
|
block ?force ?branch
|
|
~source ?src_pk ~manager_sk
|
|
~fee delegate_opt =
|
|
get_branch rpc_config block branch >>=? fun (net_id, branch) ->
|
|
Client_proto_rpcs.Context.Contract.counter
|
|
rpc_config block source >>=? fun pcounter ->
|
|
let counter = Int32.succ pcounter in
|
|
Client_proto_rpcs.Helpers.Forge.Manager.delegation rpc_config block
|
|
~branch ~source ?sourcePubKey:src_pk ~counter ~fee delegate_opt
|
|
>>=? fun bytes ->
|
|
let signature = Ed25519.sign manager_sk bytes in
|
|
let signed_bytes = Ed25519.Signature.concat bytes signature in
|
|
let oph = Operation_hash.hash_bytes [ signed_bytes ] in
|
|
Client_node_rpcs.inject_operation
|
|
rpc_config ?force ~net_id signed_bytes >>=? fun injected_oph ->
|
|
assert (Operation_hash.equal oph injected_oph) ;
|
|
return oph
|
|
|
|
let list_contract_labels cctxt block =
|
|
Client_proto_rpcs.Context.Contract.list
|
|
cctxt.rpc_config block >>=? fun contracts ->
|
|
map_s (fun h ->
|
|
begin match Contract.is_default h with
|
|
| Some m -> begin
|
|
Public_key_hash.rev_find cctxt m >>=? function
|
|
| None -> return ""
|
|
| Some nm ->
|
|
RawContractAlias.find_opt cctxt nm >>=? function
|
|
| None -> return (" (known as " ^ nm ^ ")")
|
|
| Some _ -> return (" (known as key:" ^ nm ^ ")")
|
|
end
|
|
| None -> begin
|
|
RawContractAlias.rev_find cctxt h >>=? function
|
|
| None -> return ""
|
|
| Some nm -> return (" (known as " ^ nm ^ ")")
|
|
end
|
|
end >>=? fun nm ->
|
|
let kind = match Contract.is_default h with
|
|
| Some _ -> " (default)"
|
|
| None -> "" in
|
|
let h_b58 = Contract.to_b58check h in
|
|
return (nm, h_b58, kind))
|
|
contracts
|
|
|
|
let message_injection cctxt ~force ?(contracts = []) oph =
|
|
begin
|
|
if not force then
|
|
cctxt.message "Operation successfully injected in the node."
|
|
else
|
|
Lwt.return_unit
|
|
end >>= fun () ->
|
|
cctxt.message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
|
|
Lwt_list.iter_s
|
|
(fun c ->
|
|
cctxt.message
|
|
"New contract %a originated from a smart contract."
|
|
Contract.pp c)
|
|
contracts >>= fun () ->
|
|
Lwt.return_unit
|
|
|
|
let message_added_contract cctxt name =
|
|
cctxt.message "Contract memorized as %s." name
|
|
|
|
let check_contract cctxt neu =
|
|
RawContractAlias.mem cctxt neu >>=? function
|
|
| true ->
|
|
failwith "contract '%s' already exists" neu
|
|
| false ->
|
|
return ()
|
|
|
|
let get_delegate_pkh cctxt = function
|
|
| None ->
|
|
return None
|
|
| Some delegate ->
|
|
Public_key_hash.find_opt cctxt delegate
|
|
|
|
let get_manager cctxt source =
|
|
Client_proto_contracts.get_manager
|
|
cctxt.rpc_config cctxt.config.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 () ->
|
|
return (src_name, src_pkh, src_pk, src_sk)
|
|
|
|
let group =
|
|
{ Cli_entries.name = "context" ;
|
|
title = "Block contextual commands (see option -block)" }
|
|
|
|
let dictate rpc_config ?force block command seckey =
|
|
let block = Client_rpcs.last_baked_block block in
|
|
Client_node_rpcs.Blocks.info
|
|
rpc_config block >>=? fun { net_id ; hash = branch } ->
|
|
Client_proto_rpcs.Helpers.Forge.Dictator.operation
|
|
rpc_config block ~branch command >>=? fun bytes ->
|
|
let signature = Ed25519.sign seckey bytes in
|
|
let signed_bytes = Ed25519.Signature.concat bytes signature in
|
|
let oph = Operation_hash.hash_bytes [ signed_bytes ] in
|
|
Client_node_rpcs.inject_operation
|
|
rpc_config ?force ~net_id signed_bytes >>=? fun injected_oph ->
|
|
assert (Operation_hash.equal oph injected_oph) ;
|
|
return oph
|
|
|
|
let default_fee =
|
|
match Tez.of_cents 5L with
|
|
| None -> raise (Failure "internal error: Could not parse default_fee literal")
|
|
| Some fee -> fee
|
|
|
|
let commands () =
|
|
let open Cli_entries in
|
|
let open Client_commands in
|
|
[
|
|
command ~group ~desc: "access the timestamp of the block"
|
|
no_options
|
|
(fixed [ "get" ; "timestamp" ])
|
|
begin fun () cctxt ->
|
|
Client_node_rpcs.Blocks.timestamp
|
|
cctxt.rpc_config cctxt.config.block >>=? fun v ->
|
|
cctxt.message "%s" (Time.to_notation v) >>= fun () ->
|
|
return ()
|
|
end ;
|
|
|
|
command ~group ~desc: "lists all non empty contracts of the block"
|
|
no_options
|
|
(fixed [ "list" ; "contracts" ])
|
|
begin fun () cctxt ->
|
|
list_contract_labels cctxt cctxt.config.block >>=? fun contracts ->
|
|
Lwt_list.iter_s
|
|
(fun (alias, hash, kind) -> cctxt.message "%s%s%s" hash kind alias)
|
|
contracts >>= fun () ->
|
|
return ()
|
|
end ;
|
|
|
|
command ~group ~desc: "get the balance of a contract"
|
|
no_options
|
|
(prefixes [ "get" ; "balance" ; "for" ]
|
|
@@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
|
|
@@ stop)
|
|
begin fun () (_, contract) cctxt ->
|
|
get_balance cctxt.rpc_config cctxt.config.block contract >>=? fun amount ->
|
|
cctxt.answer "%a %s" Tez.pp amount tez_sym >>= fun () ->
|
|
return ()
|
|
end ;
|
|
|
|
command ~group ~desc: "get the storage of a contract"
|
|
no_options
|
|
(prefixes [ "get" ; "storage" ; "for" ]
|
|
@@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
|
|
@@ stop)
|
|
begin fun () (_, contract) cctxt ->
|
|
get_storage cctxt.rpc_config cctxt.config.block 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 ()
|
|
end ;
|
|
|
|
command ~group ~desc: "get the manager of a contract"
|
|
no_options
|
|
(prefixes [ "get" ; "manager" ; "for" ]
|
|
@@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
|
|
@@ stop)
|
|
begin fun () (_, contract) cctxt ->
|
|
Client_proto_contracts.get_manager
|
|
cctxt.rpc_config cctxt.config.block contract >>=? 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) >>= fun () ->
|
|
return ()
|
|
end ;
|
|
|
|
command ~group ~desc: "get the delegate of a contract"
|
|
no_options
|
|
(prefixes [ "get" ; "delegate" ; "for" ]
|
|
@@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
|
|
@@ stop)
|
|
begin fun () (_, contract) cctxt ->
|
|
Client_proto_contracts.get_delegate
|
|
cctxt.rpc_config cctxt.config.block contract >>=? fun delegate ->
|
|
Public_key_hash.rev_find cctxt delegate >>=? fun mn ->
|
|
Public_key_hash.to_source cctxt delegate >>=? fun m ->
|
|
cctxt.message "%s (%s)" m
|
|
(match mn with None -> "unknown" | Some n -> "known as " ^ n) >>= fun () ->
|
|
return ()
|
|
end ;
|
|
|
|
command ~group ~desc: "set the delegate of a contract"
|
|
(args2 fee_arg force_switch)
|
|
(prefixes [ "set" ; "delegate" ; "for" ]
|
|
@@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
|
|
@@ prefix "to"
|
|
@@ Public_key_hash.alias_param
|
|
~name: "mgr" ~desc: "new delegate of the contract"
|
|
@@ stop)
|
|
begin fun (fee, force) (_, contract) (_, delegate) cctxt ->
|
|
get_manager cctxt contract >>=? fun (_src_name, _src_pkh, src_pk, src_sk) ->
|
|
delegate_contract
|
|
cctxt.rpc_config cctxt.config.block ~source:contract
|
|
~src_pk ~manager_sk:src_sk ~fee (Some delegate)
|
|
>>=? fun oph ->
|
|
message_injection cctxt ~force:force oph >>= fun () ->
|
|
return ()
|
|
end ;
|
|
|
|
command ~group ~desc: "open a new account"
|
|
(args4 fee_arg delegate_arg delegatable_switch force_switch)
|
|
(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 "transferring"
|
|
@@ tez_param
|
|
~name: "qty" ~desc: "amount taken from source"
|
|
@@ prefix "from"
|
|
@@ ContractAlias.alias_param
|
|
~name:"src" ~desc: "name of the source contract"
|
|
@@ stop)
|
|
begin fun (fee, delegate, delegatable, force)
|
|
neu (_, manager) balance (_, source) cctxt ->
|
|
check_contract cctxt neu >>=? fun () ->
|
|
get_delegate_pkh cctxt delegate >>=? fun delegate ->
|
|
get_manager cctxt source >>=? fun (_src_name, _src_pkh, src_pk, src_sk) ->
|
|
originate_account cctxt.rpc_config cctxt.config.block ~force:force
|
|
~source ~src_pk ~src_sk ~manager_pkh:manager ~balance ~fee
|
|
~delegatable:delegatable ~spendable:true ?delegate:delegate
|
|
() >>=? fun (oph, contract) ->
|
|
message_injection cctxt
|
|
~force:force ~contracts:[contract] oph >>= fun () ->
|
|
RawContractAlias.add cctxt neu contract >>=? fun () ->
|
|
message_added_contract cctxt neu >>= fun () ->
|
|
return ()
|
|
end ;
|
|
|
|
command ~group ~desc: "Launch a smart contract on the blockchain"
|
|
(args7
|
|
fee_arg delegate_arg force_switch
|
|
delegatable_switch spendable_switch init_arg no_print_source_flag)
|
|
(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 "transferring"
|
|
@@ 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 not unit"
|
|
@@ stop)
|
|
begin fun (fee, delegate, force, delegatable, spendable, init, no_print_source)
|
|
neu (_, manager) balance (_, source) program cctxt ->
|
|
Lwt.return (Micheline_parser.no_parsing_error program) >>=? fun { expanded = code } ->
|
|
check_contract cctxt neu >>=? fun () ->
|
|
get_delegate_pkh cctxt delegate >>=? fun delegate ->
|
|
get_manager cctxt source >>=? fun (_src_name, _src_pkh, src_pk, src_sk) ->
|
|
originate_contract cctxt.rpc_config cctxt.config.block ~force:force
|
|
~source ~src_pk ~src_sk ~manager_pkh:manager ~balance ~fee
|
|
~delegatable:delegatable ?delegatePubKey:delegate ~code
|
|
~init
|
|
~spendable:spendable
|
|
() >>=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 "origination simulation failed"
|
|
| Ok (oph, contract) ->
|
|
message_injection cctxt
|
|
~force:force ~contracts:[contract] oph >>= fun () ->
|
|
RawContractAlias.add cctxt neu contract >>=? fun () ->
|
|
message_added_contract cctxt neu >>= fun () ->
|
|
return ()
|
|
end ;
|
|
|
|
command ~group ~desc: "open a new (free) account"
|
|
(args1 force_switch)
|
|
(prefixes [ "originate" ; "free" ; "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"
|
|
@@ stop)
|
|
begin fun force neu (_, manager) cctxt ->
|
|
check_contract cctxt neu >>=? fun () ->
|
|
faucet cctxt.rpc_config cctxt.config.block
|
|
~force:force ~manager_pkh:manager () >>=? fun (oph, contract) ->
|
|
message_injection cctxt
|
|
~force:force ~contracts:[contract] oph >>= fun () ->
|
|
RawContractAlias.add cctxt neu contract >>=? fun () ->
|
|
message_added_contract cctxt neu >>= fun () ->
|
|
return ()
|
|
end;
|
|
|
|
command ~group ~desc: "transfer tokens"
|
|
(args4 fee_arg arg_arg force_switch no_print_source_flag)
|
|
(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)
|
|
begin fun (fee, arg, force, no_print_source) amount (_, source) (_, destination) cctxt ->
|
|
get_manager cctxt source >>=? fun (_src_name, _src_pkh, src_pk, src_sk) ->
|
|
transfer cctxt.rpc_config cctxt.config.block ~force:force
|
|
~source ~src_pk ~src_sk ~destination
|
|
~arg ~amount ~fee () >>= function
|
|
| Error errs ->
|
|
cctxt.warning "%a"
|
|
(Michelson_v1_error_reporter.report_errors
|
|
~details: false
|
|
~show_source:(not no_print_source)
|
|
?parsed:None) errs >>= fun () ->
|
|
cctxt.error "transfer simulation failed"
|
|
| Ok (oph, contracts) ->
|
|
message_injection cctxt ~force:force ~contracts oph >>= fun () ->
|
|
return ()
|
|
end;
|
|
|
|
command ~desc: "Activate a protocol"
|
|
(args1 force_switch)
|
|
(prefixes [ "activate" ; "protocol" ]
|
|
@@ Protocol_hash.param ~name:"version"
|
|
~desc:"Protocol version (b58check)"
|
|
@@ prefixes [ "with" ; "key" ]
|
|
@@ Ed25519.Secret_key.param
|
|
~name:"password" ~desc:"Dictator's key"
|
|
@@ stop)
|
|
begin fun force hash seckey cctxt ->
|
|
dictate cctxt.rpc_config cctxt.config.block
|
|
(Activate hash) seckey >>=? fun oph ->
|
|
message_injection cctxt ~force:force oph >>= fun () ->
|
|
return ()
|
|
end ;
|
|
|
|
command ~desc: "Fork a test protocol"
|
|
(args1 force_switch)
|
|
(prefixes [ "fork" ; "test" ; "protocol" ]
|
|
@@ Protocol_hash.param ~name:"version"
|
|
~desc:"Protocol version (b58check)"
|
|
@@ prefixes [ "with" ; "key" ]
|
|
@@ Ed25519.Secret_key.param
|
|
~name:"password" ~desc:"Dictator's key"
|
|
@@ stop)
|
|
begin fun force hash seckey cctxt ->
|
|
dictate cctxt.rpc_config cctxt.config.block
|
|
(Activate_testnet hash) seckey >>=? fun oph ->
|
|
message_injection cctxt ~force:force oph >>= fun () ->
|
|
return ()
|
|
end ;
|
|
|
|
]
|