From dbdcca7dbbfbc97359c4982163a57a6931c7fcec Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Wed, 5 Apr 2017 22:33:46 +0200 Subject: [PATCH] Client/Alpha: simplify `Client_proto_context` --- .../embedded/alpha/client_proto_context.ml | 594 +++++++++--------- .../embedded/alpha/client_proto_context.mli | 22 +- .../embedded/genesis/client_proto_main.ml | 43 +- .../embedded/genesis/client_proto_main.mli | 4 +- 4 files changed, 336 insertions(+), 327 deletions(-) diff --git a/src/client/embedded/alpha/client_proto_context.ml b/src/client/embedded/alpha/client_proto_context.ml index 38bcaaa78..781cdb62b 100644 --- a/src/client/embedded/alpha/client_proto_context.ml +++ b/src/client/embedded/alpha/client_proto_context.ml @@ -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 ; ] diff --git a/src/client/embedded/alpha/client_proto_context.mli b/src/client/embedded/alpha/client_proto_context.mli index 092449d6f..5ace747b2 100644 --- a/src/client/embedded/alpha/client_proto_context.mli +++ b/src/client/embedded/alpha/client_proto_context.mli @@ -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 diff --git a/src/client/embedded/genesis/client_proto_main.ml b/src/client/embedded/genesis/client_proto_main.ml index cc3e197c3..93b18e40d 100644 --- a/src/client/embedded/genesis/client_proto_main.ml +++ b/src/client/embedded/genesis/client_proto_main.ml @@ -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 ; ] diff --git a/src/client/embedded/genesis/client_proto_main.mli b/src/client/embedded/genesis/client_proto_main.mli index 451964484..73175ec19 100644 --- a/src/client/embedded/genesis/client_proto_main.mli +++ b/src/client/embedded/genesis/client_proto_main.mli @@ -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