balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Client/Alpha: simplify Client_proto_context

Browse Source
This commit is contained in:
Grégoire Henry 2017-04-05 22:33:46 +02:00 committed by Benjamin Canou
parent a6c7f355cc
commit dbdcca7dbb
4 changed files with 336 additions and 327 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

594
src/client/embedded/alpha/client_proto_context.ml
View File

@ -14,41 +14,134 @@ open Client_keys
open Client_commands
module Ed25519 = Environment.Ed25519
let check_contract cctxt neu =
RawContractAlias.mem cctxt neu >>=? function
| true ->
failwith "contract '%s' already exists" neu
| false ->
return ()
let get_balance cctxt block contract =
Client_proto_rpcs.Context.Contract.balance cctxt block contract
let get_delegate_pkh cctxt = function
| None ->
return None
| Some delegate ->
Public_key_hash.find_opt cctxt delegate
let transfer rpc_config
block ?force
~source ~src_pk ~src_sk ~destination ?arg ~amount ~fee () =
let open Cli_entries in
Client_node_rpcs.Blocks.net rpc_config block >>=? fun net ->
begin match arg with
| Some arg ->
Client_proto_programs.parse_data arg >>=? fun 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
~net ~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 = MBytes.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 signed_bytes >>=? fun injected_oph ->
assert (Operation_hash.equal oph injected_oph) ;
return (oph, contracts)
let get_timestamp cctxt block =
Client_node_rpcs.Blocks.timestamp cctxt.rpc_config block >>=? fun v ->
cctxt.message "%s" (Time.to_notation v) >>= fun () ->
return ()
let originate rpc_config ?force ~block ?signature bytes =
let signed_bytes =
match signature with
| None -> bytes
| Some signature -> MBytes.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 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 list_contracts 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 -> return nm
end
| None -> begin
RawContractAlias.rev_find cctxt h >>=? function
| None -> return ""
| Some nm -> return nm
end
end >>=? fun alias ->
return (alias, h, Contract.is_default h))
contracts
let originate_account rpc_config
block ?force
~source ~src_pk ~src_sk ~manager_pkh
?delegatable ?spendable ?delegate ~balance ~fee () =
Client_node_rpcs.Blocks.net rpc_config block >>=? fun net ->
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
~net ~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 ~signature bytes
let originate_contract rpc_config
block ?force
~source ~src_pk ~src_sk ~manager_pkh ~balance ?delegatable ?delegatePubKey
~(code:Script.code) ~init ~fee () =
Client_proto_programs.parse_data init >>=? fun storage ->
let storage = Script.{ storage ; storage_type = code.storage_type } in
Client_proto_rpcs.Context.Contract.counter
rpc_config block source >>=? fun pcounter ->
let counter = Int32.succ pcounter in
Client_node_rpcs.Blocks.net rpc_config block >>=? fun net ->
Client_proto_rpcs.Helpers.Forge.Manager.origination rpc_config block
~net ~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 ~block ~signature bytes
let faucet rpc_config block ?force ~manager_pkh () =
Client_node_rpcs.Blocks.net rpc_config block >>=? fun net ->
Client_proto_rpcs.Helpers.Forge.Anonymous.faucet
rpc_config block ~net ~id:manager_pkh () >>=? fun bytes ->
originate rpc_config ?force ~block bytes
let delegate_contract rpc_config
block ?force
~source ?src_pk ~manager_sk
~fee delegate_opt =
Client_node_rpcs.Blocks.net rpc_config block >>=? fun net ->
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
~net ~source ?sourcePubKey:src_pk ~counter ~fee delegate_opt
>>=? fun bytes ->
Client_node_rpcs.Blocks.predecessor rpc_config block >>=? fun predecessor ->
let signature = Environment.Ed25519.sign manager_sk bytes in
let signed_bytes = MBytes.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) >>=? function
| [] ->
Client_node_rpcs.inject_operation
rpc_config ?force signed_bytes >>=? fun injected_oph ->
assert (Operation_hash.equal oph injected_oph) ;
return oph
| contracts ->
failwith
"The origination introduced %d contracts instead of one."
(List.length contracts)
let dictate rpc_config block command seckey =
Client_node_rpcs.Blocks.net rpc_config block >>=? fun net ->
Client_proto_rpcs.Helpers.Forge.Dictator.operation
rpc_config block ~net command >>=? fun bytes ->
let signature = Ed25519.sign seckey bytes in
let signed_bytes = MBytes.concat bytes signature in
let oph = Operation_hash.hash_bytes [ signed_bytes ] in
Client_node_rpcs.inject_operation
rpc_config 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
@ -76,140 +169,44 @@ let list_contract_labels cctxt block =
return (nm, h_b58, kind))
contracts
let get_balance cctxt block contract =
Client_proto_rpcs.Context.Contract.balance cctxt block contract
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.rpc_config block >>=? fun net ->
begin match arg with
| Some arg ->
Client_proto_programs.parse_data arg >>=? fun arg ->
return (Some arg)
| None -> return None
end >>=? fun parameters ->
Client_proto_rpcs.Context.Contract.counter cctxt.rpc_config 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.rpc_config block
~net ~source ~sourcePubKey:src_pk ~counter ~amount
~destination ?parameters ~fee () >>=? fun bytes ->
cctxt.Client_commands.message "Forged the raw origination frame." >>= fun () ->
Client_node_rpcs.Blocks.predecessor cctxt.rpc_config block >>=? fun predecessor ->
let signature = Ed25519.sign src_sk bytes in
let signed_bytes = MBytes.concat bytes signature in
let oph = Operation_hash.hash_bytes [ signed_bytes ] in
Client_proto_rpcs.Helpers.apply_operation cctxt.rpc_config block
predecessor oph bytes (Some signature) >>=? fun contracts ->
Client_node_rpcs.inject_operation cctxt.rpc_config ?force signed_bytes >>=? fun injected_oph ->
assert (Operation_hash.equal oph injected_oph) ;
cctxt.message "Operation successfully injected in the node." >>= fun () ->
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 () ->
return contracts
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 originate cctxt ?force ~block ?signature bytes =
cctxt.Client_commands.message "Forged the raw origination frame." >>= fun () ->
let signed_bytes =
match signature with
| None -> bytes
| Some signature -> MBytes.concat bytes signature in
Client_node_rpcs.Blocks.predecessor cctxt.rpc_config block >>=? fun predecessor ->
let oph = Operation_hash.hash_bytes [ signed_bytes ] in
Client_proto_rpcs.Helpers.apply_operation cctxt.rpc_config block
predecessor oph bytes signature >>=? function
| [ contract ] ->
Client_node_rpcs.inject_operation cctxt.rpc_config ?force signed_bytes >>=? fun injected_oph ->
assert (Operation_hash.equal oph injected_oph) ;
cctxt.message "Operation successfully injected in the node." >>= fun () ->
cctxt.message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
return contract
| contracts ->
cctxt.error "The origination introduced %d contracts instead of one." (List.length contracts)
let message_added_contract cctxt name =
cctxt.message "Contract memorized as %s." name
let originate_account cctxt
block ?force
~source ~src_pk ~src_sk ~manager_pkh ?delegatable ?spendable ?delegate ~balance ~fee () =
Client_node_rpcs.Blocks.net cctxt.rpc_config block >>=? fun net ->
Client_proto_rpcs.Context.Contract.counter cctxt.rpc_config 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.rpc_config block
~net ~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 cctxt ?force ~block ~signature bytes
let originate_contract cctxt
block ?force
~source ~src_pk ~src_sk ~manager_pkh ~balance ?delegatable ?delegatePubKey
~(code:Script.code) ~init ~fee () =
Client_proto_programs.parse_data init >>=? fun storage ->
let storage = Script.{ storage ; storage_type = code.storage_type } in
Client_proto_rpcs.Context.Contract.counter cctxt.rpc_config 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.rpc_config block >>=? fun net ->
Client_proto_rpcs.Helpers.Forge.Manager.origination cctxt.rpc_config block
~net ~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 cctxt ?force ~block ~signature bytes
let faucet cctxt block ?force ~manager_pkh () =
Client_node_rpcs.Blocks.net cctxt.rpc_config block >>=? fun net ->
Client_proto_rpcs.Helpers.Forge.Anonymous.faucet cctxt.rpc_config block
~net ~id:manager_pkh () >>=? fun bytes ->
originate cctxt ?force ~block bytes
let delegate_contract cctxt
block ?force
~source ?src_pk ~manager_sk
~fee delegate_opt =
Client_node_rpcs.Blocks.net cctxt.rpc_config block >>=? fun net ->
Client_proto_rpcs.Context.Contract.counter cctxt.rpc_config 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.delegation cctxt.rpc_config block
~net ~source ?sourcePubKey:src_pk ~counter ~fee delegate_opt
>>=? fun bytes ->
cctxt.Client_commands.message "Forged the raw origination frame." >>= fun () ->
Client_node_rpcs.Blocks.predecessor cctxt.rpc_config block >>=? fun predecessor ->
let signature = Environment.Ed25519.sign manager_sk bytes in
let signed_bytes = MBytes.concat bytes signature in
let oph = Operation_hash.hash_bytes [ signed_bytes ] in
Client_proto_rpcs.Helpers.apply_operation cctxt.rpc_config block
predecessor oph bytes (Some signature) >>=? function
| [] ->
Client_node_rpcs.inject_operation cctxt.rpc_config ?force signed_bytes >>=? fun injected_oph ->
assert (Operation_hash.equal oph injected_oph) ;
cctxt.message "Operation successfully injected in the node." >>= fun () ->
cctxt.message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
let check_contract cctxt neu =
RawContractAlias.mem cctxt neu >>=? function
| true ->
failwith "contract '%s' already exists" neu
| false ->
return ()
| contracts ->
cctxt.error "The origination introduced %d contracts instead of one." (List.length contracts)
let dictate cctxt block command seckey =
Client_node_rpcs.Blocks.net cctxt.rpc_config block >>=? fun net ->
Client_proto_rpcs.Helpers.Forge.Dictator.operation
cctxt.rpc_config block ~net command >>=? fun bytes ->
let signature = Ed25519.sign seckey bytes in
let signed_bytes = MBytes.concat bytes signature in
let oph = Operation_hash.hash_bytes [ signed_bytes ] in
Client_node_rpcs.inject_operation cctxt.rpc_config signed_bytes >>=? fun injected_oph ->
assert (Operation_hash.equal oph injected_oph) ;
cctxt.message "Operation successfully injected in the node." >>= fun () ->
cctxt.message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () ->
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" ;
@ -220,141 +217,156 @@ let commands () =
let open Client_commands in
[
command ~group ~desc: "access the timestamp of the block"
(fixed [ "get" ; "timestamp" ])
(fun cctxt -> get_timestamp cctxt cctxt.config.block) ;
command ~group ~desc: "access the timestamp of the block" begin
fixed [ "get" ; "timestamp" ]
end 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"
(fixed [ "list" ; "contracts" ])
(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 ()) ;
command ~group ~desc: "lists all non empty contracts of the block" begin
fixed [ "list" ; "contracts" ]
end 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"
(prefixes [ "get" ; "balance" ]
@@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
@@ stop)
(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 ()) ;
command ~group ~desc: "get the balance of a contract" begin
prefixes [ "get" ; "balance" ]
@@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
@@ stop
end 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 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.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 ());
command ~group ~desc: "get the manager of a block" begin
prefixes [ "get" ; "manager" ]
@@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
@@ stop
end begin fun (_, contract) cctxt ->
Client_proto_rpcs.Context.Contract.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: "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.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 () ->
originate_account cctxt cctxt.config.block ~force:!force
~source ~src_pk ~src_sk ~manager_pkh:manager ~balance ~fee:!fee
~delegatable:!delegatable ~spendable:!spendable ?delegate:delegate
()) >>=? fun contract ->
RawContractAlias.add cctxt neu contract) ;
@ delegatable_args @ spendable_args) begin
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
end begin fun 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:!fee
~delegatable:!delegatable ~spendable:!spendable ?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: "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 not unit"
@@ 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.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 () ->
originate_contract cctxt cctxt.config.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 cctxt neu contract) ;
delegatable_args @ spendable_args @ [ init_arg ]) begin
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 not unit"
@@ stop
end begin fun neu (_, manager) balance (_, source) code 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_contract cctxt.rpc_config cctxt.config.block ~force:!force
~source ~src_pk ~src_sk ~manager_pkh:manager ~balance ~fee:!fee
~delegatable:!delegatable ?delegatePubKey:delegate ~code ~init:!init
() >>=? 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: "open a new (free) account"
~args: ([ fee_arg ; delegate_arg ; force_arg ]
@ delegatable_args @ spendable_args)
(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)
(fun neu (_, manager) cctxt ->
check_contract cctxt neu >>=? fun () ->
faucet cctxt cctxt.config.block ~force:!force ~manager_pkh:manager () >>=? fun contract ->
RawContractAlias.add cctxt neu contract) ;
@ delegatable_args @ spendable_args) begin
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 end
begin fun 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"
~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.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 () ->
(transfer cctxt cctxt.config.block ~force:!force
~source ~src_pk ~src_sk ~destination ?arg:!arg ~amount ~fee:!fee ()) >>=? fun contracts ->
Lwt_list.iter_s
(fun c -> cctxt.message "New contract %a originated from a smart contract."
Contract.pp c)
contracts >>= fun () ->
return ())) ;
~args: [ fee_arg ; arg_arg ; force_arg ] begin
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
end begin fun 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:!arg ~amount ~fee:!fee () >>=? fun (oph, contracts) ->
message_injection cctxt ~force:!force ~contracts oph >>= fun () ->
return ()
end;
command ~desc: "Activate a protocol" begin
prefixes [ "activate" ; "protocol" ] @@
@ -363,9 +375,12 @@ let commands () =
Environment.Ed25519.Secret_key.param
~name:"password" ~desc:"Dictator's key" @@
stop
end
(fun hash seckey cctxt ->
dictate cctxt cctxt.config.block (Activate hash) seckey) ;
end begin fun 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" begin
prefixes [ "fork" ; "test" ; "protocol" ] @@
@ -374,8 +389,11 @@ let commands () =
Environment.Ed25519.Secret_key.param
~name:"password" ~desc:"Dictator's key" @@
stop
end
(fun hash seckey cctxt ->
dictate cctxt cctxt.config.block (Activate_testnet hash) seckey) ;
end begin fun 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 ;
]

22
src/client/embedded/alpha/client_proto_context.mli
View File

@ -7,11 +7,7 @@
(* *)
(**************************************************************************)
val list_contracts:
Client_commands.context ->
Client_proto_rpcs.block ->
(string * Contract.t * Environment.Ed25519.Public_key_hash.t option)
list tzresult Lwt.t
open Environment
val get_balance:
Client_rpcs.config ->
@ -20,7 +16,7 @@ val get_balance:
Tez.t tzresult Lwt.t
val transfer:
Client_commands.context ->
Client_rpcs.config ->
Client_proto_rpcs.block ->
?force:bool ->
source:Contract.t ->
@ -30,10 +26,10 @@ val transfer:
?arg:string ->
amount:Tez.t ->
fee:Tez.t ->
unit -> Contract.t list tzresult Lwt.t
unit -> (Operation_hash.t * Contract.t list) tzresult Lwt.t
val originate_account:
Client_commands.context ->
Client_rpcs.config ->
Client_proto_rpcs.block ->
?force:bool ->
source:Contract.t ->
@ -45,10 +41,10 @@ val originate_account:
?delegate:public_key_hash ->
balance:Tez.t ->
fee:Tez.t ->
unit -> Contract.t tzresult Lwt.t
unit -> (Operation_hash.t * Contract.t) tzresult Lwt.t
val originate_contract:
Client_commands.context ->
Client_rpcs.config ->
Client_proto_rpcs.block ->
?force:bool ->
source:Contract.t ->
@ -61,10 +57,10 @@ val originate_contract:
code:Script.code ->
init:string ->
fee:Tez.t ->
unit -> Contract.t tzresult Lwt.t
unit -> (Operation_hash.t * Contract.t) tzresult Lwt.t
val delegate_contract:
Client_commands.context ->
Client_rpcs.config ->
Client_proto_rpcs.block ->
?force:bool ->
source:Contract.t ->
@ -72,6 +68,6 @@ val delegate_contract:
manager_sk:secret_key ->
fee:Tez.t ->
public_key_hash option ->
unit tzresult Lwt.t
Operation_hash.t tzresult Lwt.t
val commands: unit -> Client_commands.command list

43
src/client/embedded/genesis/client_proto_main.ml
View File

@ -13,37 +13,28 @@ let protocol =
Protocol_hash.of_b58check_exn
"ProtoGenesisGenesisGenesisGenesisGenesisGenesk612im"
let call_service1 cctxt s block a1 =
Client_rpcs.call_service1 cctxt
let call_service1 rpc_config s block a1 =
Client_rpcs.call_service1 rpc_config
(s Node_rpc_services.Blocks.proto_path) block a1
let call_error_service1 cctxt s block a1 =
call_service1 cctxt s block a1 >>= function
let call_error_service1 rpc_config s block a1 =
call_service1 rpc_config s block a1 >>= function
| Ok (Error _ as err) -> Lwt.return (wrap_error err)
| Ok (Ok v) -> return v
| Error _ as err -> Lwt.return err
let forge_block
cctxt block net_id ?(timestamp = Time.now ()) command fitness =
Client_blocks.get_block_hash cctxt block >>=? fun pred ->
call_service1 cctxt
rpc_config block net_id ?(timestamp = Time.now ()) command fitness =
Client_blocks.get_block_hash rpc_config block >>=? fun pred ->
call_service1 rpc_config
Services.Forge.block block
((net_id, pred, timestamp, fitness), command)
let mine cctxt ?timestamp block command fitness seckey =
Client_blocks.get_block_info cctxt.rpc_config block >>=? fun bi ->
forge_block cctxt.rpc_config ?timestamp block bi.net command fitness >>=? fun blk ->
let mine rpc_config ?timestamp block command fitness seckey =
Client_blocks.get_block_info rpc_config block >>=? fun bi ->
forge_block rpc_config ?timestamp block bi.net command fitness >>=? fun blk ->
let signed_blk = Environment.Ed25519.Signature.append seckey blk in
Client_node_rpcs.inject_block cctxt.rpc_config signed_blk [[]] >>=? fun hash ->
cctxt.answer "Injected %a" Block_hash.pp_short hash >>= fun () ->
return ()
let handle_error cctxt = function
| Ok res ->
Lwt.return res
| Error exns ->
pp_print_error Format.err_formatter exns ;
cctxt.Client_commands.error "%s" "cannot continue"
Client_node_rpcs.inject_block rpc_config signed_blk [[]]
let commands () =
let timestamp = ref None in
@ -71,8 +62,10 @@ let commands () =
let timestamp = !timestamp in
let fitness =
Client_embedded_proto_alpha.Fitness_repr.from_int64 fitness in
mine cctxt ?timestamp cctxt.config.block
(Activate hash) fitness seckey
mine cctxt.rpc_config ?timestamp cctxt.config.block
(Activate hash) fitness seckey >>=? fun hash ->
cctxt.answer "Injected %a" Block_hash.pp_short hash >>= fun () ->
return ()
end ;
command ~args ~desc: "Fork a test protocol" begin
@ -92,8 +85,10 @@ let commands () =
let timestamp = !timestamp in
let fitness =
Client_embedded_proto_alpha.Fitness_repr.from_int64 fitness in
mine cctxt ?timestamp cctxt.config.block
(Activate_testnet hash) fitness seckey
mine cctxt.rpc_config ?timestamp cctxt.config.block
(Activate_testnet hash) fitness seckey >>=? fun hash ->
cctxt.answer "Injected %a" Block_hash.pp_short hash >>= fun () ->
return ()
end ;
]

4
src/client/embedded/genesis/client_proto_main.mli
View File

@ -8,11 +8,11 @@
(**************************************************************************)
val mine:
Client_commands.context ->
Client_rpcs.config ->
?timestamp: Time.t ->
Client_node_rpcs.Blocks.block ->
Data.Command.t ->
Fitness.fitness ->
Environment.Ed25519.Secret_key.t ->
unit tzresult Lwt.t
Block_hash.t tzresult Lwt.t