From 72e31287d1c5f29f32a2aba8841a5dec7c54cbf8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Sun, 22 Apr 2018 10:50:34 +0200 Subject: [PATCH] Client/Alpha: split module `Client_proto_context` --- src/lib_client_base/client_confirmations.ml | 67 ++ src/lib_client_base/client_confirmations.mli | 15 + .../lib_baking/test/proto_alpha_helpers.ml | 13 +- .../lib_client/client_proto_context.ml | 737 +++--------------- .../lib_client/client_proto_context.mli | 60 +- .../lib_client/client_proto_programs.ml | 4 +- src/proto_alpha/lib_client/injection.ml | 145 ++++ src/proto_alpha/lib_client/injection.mli | 33 + .../lib_client/operation_result.ml | 351 +++++++++ .../lib_client/operation_result.mli | 17 + .../client_proto_context_commands.ml | 87 +-- 11 files changed, 827 insertions(+), 702 deletions(-) create mode 100644 src/lib_client_base/client_confirmations.ml create mode 100644 src/lib_client_base/client_confirmations.mli create mode 100644 src/proto_alpha/lib_client/injection.ml create mode 100644 src/proto_alpha/lib_client/injection.mli create mode 100644 src/proto_alpha/lib_client/operation_result.ml create mode 100644 src/proto_alpha/lib_client/operation_result.mli diff --git a/src/lib_client_base/client_confirmations.ml b/src/lib_client_base/client_confirmations.ml new file mode 100644 index 000000000..a3b5d8032 --- /dev/null +++ b/src/lib_client_base/client_confirmations.ml @@ -0,0 +1,67 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +let wait_for_operation_inclusion + (ctxt : #Client_context.full) + ?(predecessors = 10) + ?(confirmations = 1) + operation_hash = + let confirmed_blocks = Hashtbl.create confirmations in + let process block = + Block_services.hash ctxt block >>=? fun hash -> + Block_services.predecessor ctxt block >>=? fun predecessor -> + match Hashtbl.find_opt confirmed_blocks predecessor with + | Some n -> + ctxt#answer + "Operation received %d confirmations as of block: %a" + (n+1) Block_hash.pp hash >>= fun () -> + if n+1 < confirmations then begin + Hashtbl.add confirmed_blocks hash (n+1) ; + return false + end else + return true + | None -> + Block_services.operations + ctxt ~contents:false block >>=? fun operations -> + let in_block = + List.exists + (List.exists + (fun (oph, _) -> Operation_hash.equal operation_hash oph)) + operations in + if not in_block then + return false + else begin + ctxt#answer + "Operation found in block: %a" + Block_hash.pp hash >>= fun () -> + if confirmations <= 0 then + return true + else begin + Hashtbl.add confirmed_blocks hash 0 ; + return false + end + end in + Block_services.monitor + ~include_ops:false + ~length:predecessors ctxt >>=? fun (stream, stop) -> + let exception WrapError of error list in + let stream = Lwt_stream.map_list List.concat stream in + Lwt.catch + (fun () -> + Lwt_stream.find_s + (fun bi -> + process (`Hash (bi.Block_services.hash, 0)) >>= function + | Ok b -> Lwt.return b + | Error err -> + Lwt.fail (WrapError err)) stream >>= return) + (function + | WrapError e -> Lwt.return (Error e) + | exn -> Lwt.fail exn) >>=? fun _ -> + stop () ; + return () diff --git a/src/lib_client_base/client_confirmations.mli b/src/lib_client_base/client_confirmations.mli new file mode 100644 index 000000000..2def1cc79 --- /dev/null +++ b/src/lib_client_base/client_confirmations.mli @@ -0,0 +1,15 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +val wait_for_operation_inclusion: + #Client_context.full -> + ?predecessors:int -> + ?confirmations:int -> + Operation_hash.t -> + unit tzresult Lwt.t diff --git a/src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml b/src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml index c31471106..66a635092 100644 --- a/src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml +++ b/src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml @@ -259,7 +259,8 @@ module Account = struct ~src_sk ~destination ~amount - ~fee () + ~fee () >>=? fun ((oph, _, _), contracts) -> + return (oph, contracts) let originate ?(block = `Head 0) @@ -275,6 +276,8 @@ module Account = struct let src_sk = Tezos_signer_backends.Unencrypted.make_sk src.sk in Client_proto_context.originate_account + (new wrap_full (no_write_context !rpc_config)) + block ~source:src.contract ~src_pk:src.pk ~src_sk @@ -283,9 +286,8 @@ module Account = struct ~delegatable ?delegate ~fee - block - (new wrap_full (no_write_context !rpc_config)) - () + () >>=? fun ((oph, _, _), contracts) -> + return (oph, contracts) let set_delegate ?(block = `Head 0) @@ -301,7 +303,8 @@ module Account = struct contract ~src_pk ~manager_sk - delegate_opt + delegate_opt >>=? fun (oph, _, _) -> + return oph let balance ?(block = `Head 0) (account : t) = Alpha_services.Contract.balance !rpc_ctxt diff --git a/src/proto_alpha/lib_client/client_proto_context.ml b/src/proto_alpha/lib_client/client_proto_context.ml index 6ea7f80bd..801daa9d4 100644 --- a/src/proto_alpha/lib_client/client_proto_context.ml +++ b/src/proto_alpha/lib_client/client_proto_context.ml @@ -12,7 +12,6 @@ open Alpha_context open Tezos_micheline open Client_proto_contracts open Client_keys -open Apply_operation_result let get_balance (rpc : #Proto_alpha.rpc_context) block contract = Alpha_services.Contract.balance rpc block contract @@ -20,396 +19,27 @@ let get_balance (rpc : #Proto_alpha.rpc_context) block contract = let get_storage (rpc : #Proto_alpha.rpc_context) block contract = Alpha_services.Contract.storage_opt rpc block contract -let get_branch rpc_config block branch = - let branch = Option.unopt ~default:0 branch in (* TODO export parameter *) - begin - match block with - | `Head n -> return (`Head (n+branch)) - | `Test_head n -> return (`Test_head (n+branch)) - | `Hash (h,n) -> return (`Hash (h,n+branch)) - | `Genesis -> return `Genesis - end >>=? fun block -> - Block_services.info rpc_config block >>=? fun { chain_id ; hash } -> - return (chain_id, hash) - let parse_expression arg = Lwt.return (Micheline_parser.no_parsing_error (Michelson_v1_parser.parse_expression arg)) -let pp_manager_operation_content ppf source operation internal pp_result result = - Format.fprintf ppf "@[" ; - begin match operation with - | Alpha_context.Transaction { destination ; amount ; parameters } -> - Format.fprintf ppf - "@[%s:@,\ - Amount: %s%a@,\ - From: %a@,\ - To: %a" - (if internal then "Internal transaction" else "Transaction") - Client_proto_args.tez_sym - Tez.pp amount - Contract.pp source - Contract.pp destination ; - begin match parameters with - | None -> () - | Some expr -> - Format.fprintf ppf - "@,Parameter: @[%a@]" - Michelson_v1_printer.print_expr expr - end ; - pp_result ppf result ; - Format.fprintf ppf "@]" ; - | Origination { manager ; delegate ; credit ; spendable ; delegatable ; script } -> - Format.fprintf ppf "@[%s:@,\ - From: %a@,\ - For: %a@,\ - Credit: %s%a" - (if internal then "Internal origination" else "Origination") - Contract.pp source - Signature.Public_key_hash.pp manager - Client_proto_args.tez_sym - Tez.pp credit ; - begin match script with - | None -> Format.fprintf ppf "@,No script (accepts all transactions)" - | Some { code ; storage } -> - Format.fprintf ppf - "@,@[Script:@ %a\ - @,@[Initial storage:@ %a@]" - Michelson_v1_printer.print_expr code - Michelson_v1_printer.print_expr storage - end ; - begin match delegate with - | None -> Format.fprintf ppf "@,No delegate for this contract" - | Some delegate -> Format.fprintf ppf "@,Delegate: %a" Signature.Public_key_hash.pp delegate - end ; - if spendable then Format.fprintf ppf "@,Spendable by the manager" ; - if delegatable then Format.fprintf ppf "@,Delegate can be changed by the manager" ; - pp_result ppf result ; - Format.fprintf ppf "@]" ; - | Reveal key -> - Format.fprintf ppf - "@[%s of manager public key:@,\ - Contract: %a@,\ - Key: %a%a@]" - (if internal then "Internal revelation" else "Revelation") - Contract.pp source - Signature.Public_key.pp key - pp_result result - | Delegation None -> - Format.fprintf ppf - "@[%s:@,\ - Contract: %a@,\ - To: nobody%a@]" - (if internal then "Internal Delegation" else "Delegation") - Contract.pp source - pp_result result - | Delegation (Some delegate) -> - Format.fprintf ppf - "@[%s:@,\ - Contract: %a@,\ - To: %a%a@]" - (if internal then "Internal Delegation" else "Delegation") - Contract.pp source - Signature.Public_key_hash.pp delegate - pp_result result - end ; - Format.fprintf ppf "@]" - -let pp_balance_updates ppf = function - | [] -> () - | balance_updates -> - let balance_updates = - List.map (fun (balance, update) -> - let balance = match balance with - | Contract c -> - Format.asprintf "%a" Contract.pp c - | Rewards (pkh, l) -> - Format.asprintf "rewards(%a,%a)" - Signature.Public_key_hash.pp pkh Cycle.pp l - | Fees (pkh, l) -> - Format.asprintf "fees(%a,%a)" - Signature.Public_key_hash.pp pkh Cycle.pp l - | Deposits (pkh, l) -> - Format.asprintf "deposits(%a,%a)" - Signature.Public_key_hash.pp pkh Cycle.pp l in - (balance, update)) balance_updates in - let column_size = - List.fold_left - (fun acc (balance, _) -> Compare.Int.max acc (String.length balance)) - 0 balance_updates in - let pp_update ppf = function - | Credited amount -> Format.fprintf ppf "+%s%a" Client_proto_args.tez_sym Tez.pp amount - | Debited amount -> Format.fprintf ppf "-%s%a" Client_proto_args.tez_sym Tez.pp amount in - let pp_one ppf (balance, update) = - let to_fill = column_size + 3 - String.length balance in - let filler = String.make to_fill '.' in - Format.fprintf ppf "%s %s %a" balance filler pp_update update in - Format.fprintf ppf "@[%a@]" - (Format.pp_print_list pp_one) balance_updates - -let pp_operation_result ppf ({ contents ; _ }, operation_result) = - Format.fprintf ppf "@[" ; - begin match contents, operation_result with - | Anonymous_operations ops, Anonymous_operations_result rs -> - let ops_rs = List.combine ops rs in - let pp_anonymous_operation_result ppf = function - | Seed_nonce_revelation { level ; nonce }, - Seed_nonce_revelation_result bus -> - Format.fprintf ppf - "@[Seed nonce revelation:@,\ - Level: %a@,\ - Nonce (hash): %a@,\ - Balance updates:@,\ - \ %a@]" - Raw_level.pp level - Nonce_hash.pp (Nonce.hash nonce) - pp_balance_updates bus - | Double_baking_evidence { bh1 ; bh2 }, - Double_baking_evidence_result bus -> - Format.fprintf ppf - "@[Double baking evidence:@,\ - Exhibit A: %a@,\ - Exhibit B: %a@,\ - Balance updates:@,\ - \ %a@]" - Block_hash.pp (Block_header.hash bh1) - Block_hash.pp (Block_header.hash bh2) - pp_balance_updates bus - | Double_endorsement_evidence { op1 ; op2}, - Double_endorsement_evidence_result bus -> - Format.fprintf ppf - "@[Double endorsement evidence:@,\ - Exhibit A: %a@,\ - Exhibit B: %a@,\ - Balance updates:@,\ - \ %a@]" - Operation_hash.pp (Operation.hash op1) - Operation_hash.pp (Operation.hash op2) - pp_balance_updates bus - | Activation { id ; _ }, - Activation_result bus -> - Format.fprintf ppf - "@[Genesis account activation:@,\ - Account: %a@,\ - Balance updates:@,\ - \ %a@]" - Ed25519.Public_key_hash.pp id - pp_balance_updates bus - | _, _ -> invalid_arg "Apply_operation_result.pp" - in - Format.pp_print_list pp_anonymous_operation_result ppf ops_rs - | Sourced_operations - (Consensus_operation - (Endorsements { block ; level ; slots })), - Sourced_operation_result - (Consensus_operation_result - (Endorsements_result (delegate, _slots))) -> - Format.fprintf ppf - "@[Endorsement:@,\ - Block: %a@,\ - Level: %a@,\ - Delegate: %a@,\ - Slots: %a@]" - Block_hash.pp block - Raw_level.pp level - Signature.Public_key_hash.pp delegate - (Format.pp_print_list - ~pp_sep:Format.pp_print_space - Format.pp_print_int) - slots - | Sourced_operations - (Amendment_operation { source ; operation = Proposals { period ; proposals } }), - Sourced_operation_result Amendment_operation_result -> - Format.fprintf ppf - "@[Proposals:@,\ - From: %a@,\ - Period: %a@,\ - Protocols:@,\ - \ @[%a@]@]" - Signature.Public_key_hash.pp source - Voting_period.pp period - (Format.pp_print_list Protocol_hash.pp) proposals - | Sourced_operations - (Amendment_operation { source ; operation = Ballot { period ; proposal ; ballot } }), - Sourced_operation_result Amendment_operation_result -> - Format.fprintf ppf - "@[Ballot:@,\ - From: %a@,\ - Period: %a@,\ - Protocol: %a@,\ - Vote: %s@]" - Signature.Public_key_hash.pp source - Voting_period.pp period - Protocol_hash.pp proposal - (match ballot with Yay -> "YAY" | Pass -> "PASS" | Nay -> "NAY") - | Sourced_operations (Dictator_operation (Activate protocol)), - Sourced_operation_result Dictator_operation_result -> - Format.fprintf ppf - "@[Dictator protocol activation:@,\ - Protocol: %a@]" - Protocol_hash.pp protocol - | Sourced_operations (Dictator_operation (Activate_testchain protocol)), - Sourced_operation_result Dictator_operation_result -> - Format.fprintf ppf - "@[Dictator test protocol activation:@,\ - Protocol: %a@]" - Protocol_hash.pp protocol - | Sourced_operations (Manager_operations { source ; fee ; counter ; operations ; gas_limit }), - Sourced_operation_result (Manager_operations_result { balance_updates ; operation_results }) -> - let pp_result ppf result = - Format.fprintf ppf "@," ; - match result with - | Skipped -> - Format.fprintf ppf - "This operation was skipped" - | Failed errs -> - Format.fprintf ppf - "@[This operation FAILED with the folllowing error:@,%a@]" - (Format.pp_print_list Alpha_environment.Error_monad.pp) errs - | Applied Reveal_result -> - Format.fprintf ppf - "This revelation was successfully applied" - | Applied Delegation_result -> - Format.fprintf ppf - "This delegation was successfully applied" - | Applied (Transaction_result { balance_updates ; consumed_gas ; - operations ; storage ; - originated_contracts ; storage_fees_increment }) -> - Format.fprintf ppf - "This transaction was successfully applied" ; - begin match operations with - | [] -> () - | ops -> Format.fprintf ppf "@,Internal operations: %d" (List.length ops) - end ; - begin match originated_contracts with - | [] -> () - | contracts -> - Format.fprintf ppf "@,@[Originated contracts:@,%a@]" - (Format.pp_print_list Contract.pp) contracts - end ; - begin match storage with - | None -> () - | Some expr -> - Format.fprintf ppf "@,@[Updated storage:@ %a@]" - Michelson_v1_printer.print_expr expr - end ; - begin if storage_fees_increment <> Tez.zero then - Format.fprintf ppf - "@,Storage fees increment: %s%a" - Client_proto_args.tez_sym - Tez.pp storage_fees_increment - end ; - Format.fprintf ppf - "@,Consumed gas: %s" - (Z.to_string consumed_gas) ; - begin match balance_updates with - | [] -> () - | balance_updates -> - Format.fprintf ppf - "@,Balance updates:@, %a" - pp_balance_updates balance_updates - end - | Applied (Origination_result { balance_updates ; consumed_gas ; - originated_contracts ; storage_fees_increment }) -> - Format.fprintf ppf - "This origination was successfully applied" ; - begin match originated_contracts with - | [] -> () - | contracts -> - Format.fprintf ppf "@,@[Originated contracts:@,%a@]" - (Format.pp_print_list Contract.pp) contracts - end ; - begin if storage_fees_increment <> Tez.zero then - Format.fprintf ppf - "@,Storage fees increment: %s%a" - Client_proto_args.tez_sym - Tez.pp storage_fees_increment - end ; - Format.fprintf ppf - "@,Consumed gas: %s" - (Z.to_string consumed_gas) ; - begin match balance_updates with - | [] -> () - | balance_updates -> - Format.fprintf ppf - "@,Balance updates:@, %a" - pp_balance_updates balance_updates - end in - let rec pp_manager_operations_results ppf = function - | [], [] -> () - | operation :: ops, (External, r) :: rs -> - Format.fprintf ppf "@," ; - pp_manager_operation_content ppf source operation false pp_result r ; - pp_manager_operations_results ppf (ops, rs) - | ops, (Internal { source ; operation }, r) :: rs -> - Format.fprintf ppf "@," ; - pp_manager_operation_content ppf source operation true pp_result r ; - pp_manager_operations_results ppf (ops, rs) - | [], _ :: _ - | _ :: _, [] -> invalid_arg "Apply_operation_result.pp" in - Format.fprintf ppf - "@[@[Manager signed operations:@,\ - From: %a@,\ - Fee to the baker: %s%a@,\ - Expected counter: %ld@,\ - Gas limit: %s" - Contract.pp source - Client_proto_args.tez_sym - Tez.pp fee - counter - (Z.to_string gas_limit) ; - begin match balance_updates with - | [] -> () - | balance_updates -> - Format.fprintf ppf - "@,Balance updates:@, %a" - pp_balance_updates balance_updates - end ; - Format.fprintf ppf - "@]%a@]" - pp_manager_operations_results (operations, operation_results) - | _, _ -> invalid_arg "Apply_operation_result.pp" - end ; - Format.fprintf ppf "@]" - -let pp_internal_operation ppf { source ; operation } = - pp_manager_operation_content ppf source operation true (fun _ppf () -> ()) () - -let estimated_gas = function - | Sourced_operation_result (Manager_operations_result { operation_results }) -> - List.fold_left - (fun acc (_, r) -> acc >>? fun acc -> - match r with - | Applied (Transaction_result { consumed_gas } - | Origination_result { consumed_gas }) -> - Ok (Z.add consumed_gas acc) - | Applied Reveal_result -> Ok acc - | Applied Delegation_result -> Ok acc - | Skipped -> assert false - | Failed errs -> Alpha_environment.wrap_error (Error errs)) - (Ok Z.zero) operation_results - | _ -> Ok Z.zero - -let originated_contracts = function - | Sourced_operation_result (Manager_operations_result { operation_results }) -> - List.fold_left - (fun acc (_, r) -> acc >>? fun acc -> - match r with - | Applied (Transaction_result { originated_contracts } - | Origination_result { originated_contracts }) -> - Ok (originated_contracts @ acc) - | Applied Reveal_result -> Ok acc - | Applied Delegation_result -> Ok acc - | Skipped -> assert false - | Failed errs -> Alpha_environment.wrap_error (Error errs)) - (Ok []) operation_results - | _ -> Ok [] +let append_reveal + cctxt block + ~source ~src_pk ops = + Alpha_services.Contract.manager_key cctxt block source >>=? fun (_pkh, pk) -> + let is_reveal = function + | Reveal _ -> true + | _ -> false in + match pk with + | None when not (List.exists is_reveal ops) -> + return (Reveal src_pk :: ops) + | _ -> return ops let transfer (cctxt : #Proto_alpha.full) - block ?branch - ~source ~src_pk ~src_sk ~destination ?arg ~amount ~fee ?gas_limit () = - get_branch cctxt block branch >>=? fun (chain_id, branch) -> + block ?confirmations + ?branch ~source ~src_pk ~src_sk ~destination ?arg + ~amount ~fee ?(gas_limit = Z.minus_one) () = begin match arg with | Some arg -> parse_expression arg >>=? fun { expanded = arg } -> @@ -419,136 +49,95 @@ let transfer (cctxt : #Proto_alpha.full) Alpha_services.Contract.counter cctxt block source >>=? fun pcounter -> let counter = Int32.succ pcounter in - Block_services.predecessor cctxt block >>=? fun predecessor -> - begin match gas_limit with - | Some gas_limit -> return gas_limit - | None -> - Alpha_services.Constants.hard_gas_limits cctxt block >>=? fun (_, max_gas) -> - Alpha_services.Forge.Manager.transaction - cctxt block - ~branch ~source ~sourcePubKey:src_pk ~counter ~amount - ~destination ?parameters ~fee ~gas_limit:max_gas () >>=? fun bytes -> - Client_keys.sign - src_sk ~watermark:Generic_operation bytes >>=? fun signature -> - let signed_bytes = Signature.concat bytes signature in - let oph = Operation_hash.hash_bytes [ signed_bytes ] in - Alpha_services.Helpers.apply_operation cctxt block - predecessor oph bytes (Some signature) >>=? fun result -> - Lwt.return (estimated_gas result) >>=? fun gas -> - if Z.equal gas Z.zero then - cctxt#message "Estimated gas: none" >>= fun () -> - return Z.zero - else - cctxt#message "Estimated gas: %s units (will add 100 for safety)" (Z.to_string gas) >>= fun () -> - return (Z.add gas (Z.of_int 100)) - end >>=? fun gas_limit -> - Alpha_services.Forge.Manager.transaction - cctxt block - ~branch ~source ~sourcePubKey:src_pk ~counter ~amount - ~destination ?parameters ~fee ~gas_limit () >>=? fun bytes -> - Client_keys.sign - src_sk ~watermark:Generic_operation bytes >>=? fun signature -> - let signed_bytes = Signature.concat bytes signature in - let oph = Operation_hash.hash_bytes [ signed_bytes ] in - Alpha_services.Helpers.apply_operation cctxt block - predecessor oph bytes (Some signature) >>=? fun result -> - cctxt#message - "@[This sequence of operations was run:@,%a@]" - pp_operation_result (Data_encoding.Binary.of_bytes_exn Operation.encoding signed_bytes, result) >>= fun () -> - Shell_services.inject_operation - cctxt ~chain_id signed_bytes >>=? fun injected_oph -> - assert (Operation_hash.equal oph injected_oph) ; - Lwt.return (originated_contracts result) >>=? fun contracts -> - return (oph, contracts) + let operations = [Transaction { amount ; parameters ; destination }] in + append_reveal cctxt block ~source ~src_pk operations >>=? fun operations -> + let contents = + Sourced_operations + (Manager_operations { source ; fee ; counter ; + gas_limit ; operations }) in + Injection.inject_operation cctxt block ?confirmations + ?branch ~src_sk contents >>=? fun (_oph, _op, result as res) -> + Lwt.return (Injection.originated_contracts result) >>=? fun contracts -> + return (res, contracts) let reveal cctxt - block ?branch ~source ~src_pk ~src_sk ~fee () = - get_branch cctxt block branch >>=? fun (chain_id, branch) -> + block ?confirmations + ?branch ~source ~src_pk ~src_sk ~fee () = Alpha_services.Contract.counter cctxt block source >>=? fun pcounter -> let counter = Int32.succ pcounter in - Alpha_services.Forge.Manager.reveal - cctxt block - ~branch ~source ~sourcePubKey:src_pk ~counter ~fee () >>=? fun bytes -> - Client_keys.sign - src_sk ~watermark:Generic_operation bytes >>=? fun signature -> - let signed_bytes = Signature.concat bytes signature in - let oph = Operation_hash.hash_bytes [ signed_bytes ] in - Shell_services.inject_operation - cctxt ~chain_id signed_bytes >>=? fun injected_oph -> - assert (Operation_hash.equal oph injected_oph) ; - return oph + append_reveal cctxt block ~source ~src_pk [] >>=? fun operations -> + match operations with + | [] -> + failwith "The manager key was previously revealed." + | _ :: _ -> + let gas_limit = Z.zero in + let contents = + Sourced_operations + (Manager_operations { source ; fee ; counter ; + gas_limit ; operations }) in + Injection.inject_operation cctxt block ?confirmations + ?branch ~src_sk contents >>=? fun res -> + return res -let originate (cctxt : #Client_context.full) ?chain_id ~block ?signature bytes = - let signed_bytes = - match signature with - | None -> bytes - | Some signature -> Signature.concat bytes signature in - Block_services.predecessor cctxt block >>=? fun predecessor -> - let oph = Operation_hash.hash_bytes [ signed_bytes ] in - Alpha_services.Helpers.apply_operation cctxt block - predecessor oph bytes signature >>=? fun result -> - Lwt.return (originated_contracts result) >>=? function - | [ contract ] -> - cctxt#message - "@[This sequence of operations was run:@,%a@]" - pp_operation_result (Data_encoding.Binary.of_bytes_exn Operation.encoding signed_bytes, result) >>= fun () -> - Shell_services.inject_operation - cctxt ?chain_id signed_bytes >>=? fun injected_oph -> - assert (Operation_hash.equal oph injected_oph) ; - return (oph, contract) +let originate + cctxt block ?confirmations + ?branch ~source ~src_pk ~src_sk ~fee ?(gas_limit = Z.minus_one) origination = + Alpha_services.Contract.counter cctxt block source >>=? fun pcounter -> + let counter = Int32.succ pcounter in + let operations = [origination] in + append_reveal + cctxt block ~source ~src_pk operations >>=? fun operations -> + let contents = + Sourced_operations + (Manager_operations { source ; fee ; counter ; + gas_limit ; operations }) in + Injection.inject_operation cctxt block ?confirmations + ?branch ~src_sk contents >>=? fun (_oph, _op, result as res) -> + Lwt.return (Injection.originated_contracts result) >>=? function + | [ contract ] -> return (res, contract) | contracts -> failwith "The origination introduced %d contracts instead of one." (List.length contracts) -let operation_submitted_message (cctxt : #Client_context.printer) ?(contracts = []) oph = - cctxt#message "Operation successfully injected in the node." >>= fun () -> - cctxt#message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () -> - Lwt_list.iter_s - (fun c -> - cctxt#message - "New contract %a originated." - Contract.pp c) - contracts >>= return - -let originate_account ?branch - ~source ~src_pk ~src_sk ~manager_pkh - ?delegatable ?delegate ~balance ~fee block cctxt () = - get_branch cctxt block branch >>=? fun (chain_id, branch) -> - Alpha_services.Contract.counter - cctxt block source >>=? fun pcounter -> - let counter = Int32.succ pcounter in - Alpha_services.Forge.Manager.origination cctxt block - ~branch ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh - ~counter ~balance ~spendable:true - ?delegatable ?delegatePubKey:delegate ~fee ~gas_limit:Z.zero () >>=? fun bytes -> - Client_keys.sign - src_sk ~watermark:Generic_operation bytes >>=? fun signature -> - originate cctxt ~block ~chain_id ~signature bytes +let originate_account + cctxt block ?confirmations + ?branch ~source ~src_pk ~src_sk ~manager_pkh + ?(delegatable = false) ?delegate ~balance ~fee () = + let origination = + Origination { manager = manager_pkh ; + delegate ; + script = None ; + spendable = true ; + delegatable ; + credit = balance ; + preorigination = None } in + originate + cctxt block ?confirmations + ?branch ~source ~gas_limit:Z.zero~src_pk ~src_sk ~fee origination let delegate_contract cctxt - block ?branch - ~source ?src_pk ~manager_sk + block ?branch ?confirmations + ~source ~src_pk ~src_sk ~fee delegate_opt = - get_branch cctxt block branch >>=? fun (chain_id, branch) -> Alpha_services.Contract.counter cctxt block source >>=? fun pcounter -> let counter = Int32.succ pcounter in - Alpha_services.Forge.Manager.delegation cctxt block - ~branch ~source ?sourcePubKey:src_pk ~counter ~fee delegate_opt - >>=? fun bytes -> - Client_keys.sign - manager_sk ~watermark:Generic_operation bytes >>=? fun signature -> - let signed_bytes = Signature.concat bytes signature in - let oph = Operation_hash.hash_bytes [ signed_bytes ] in - Shell_services.inject_operation - cctxt ~chain_id signed_bytes >>=? fun injected_oph -> - assert (Operation_hash.equal oph injected_oph) ; - return oph + let operations = [Delegation delegate_opt] in + append_reveal + cctxt block ~source ~src_pk operations >>=? fun operations -> + let contents = + Sourced_operations + (Manager_operations { source ; fee ; counter ; + gas_limit = Z.zero ; operations }) in + Injection.inject_operation cctxt block ?confirmations + ?branch ~src_sk contents >>=? fun res -> + return res -let list_contract_labels (cctxt : #Proto_alpha.full) block = - Alpha_services.Contract.list - cctxt block >>=? fun contracts -> +let list_contract_labels + (cctxt : #Proto_alpha.full) + block = + Alpha_services.Contract.list cctxt block >>=? fun contracts -> map_s (fun h -> begin match Contract.is_implicit h with | Some m -> begin @@ -575,34 +164,30 @@ let list_contract_labels (cctxt : #Proto_alpha.full) block = let message_added_contract (cctxt : #Proto_alpha.full) name = cctxt#message "Contract memorized as %s." name -let get_manager (cctxt : #Proto_alpha.full) block source = +let get_manager + (cctxt : #Proto_alpha.full) + block source = 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) -> return (src_name, src_pkh, src_pk, src_sk) -let dictate rpc_config block command seckey = - Block_services.info - rpc_config block >>=? fun { chain_id ; hash = branch } -> - Alpha_services.Forge.Dictator.operation - rpc_config block ~branch command >>=? fun bytes -> - let signed_bytes = - Signature.append ~watermark:Generic_operation seckey bytes in - let oph = Operation_hash.hash_bytes [ signed_bytes ] in - Shell_services.inject_operation - rpc_config ~chain_id signed_bytes >>=? fun injected_oph -> - assert (Operation_hash.equal oph injected_oph) ; - return oph +let dictate rpc_config block ?confirmations command src_sk = + let contents = Sourced_operations (Dictator_operation command) in + Injection.inject_operation + rpc_config block ?confirmations + ~src_sk contents >>=? fun res -> + return res -let set_delegate cctxt block ~fee contract ~src_pk ~manager_sk opt_delegate = +let set_delegate cctxt block ?confirmations ~fee contract ~src_pk ~manager_sk opt_delegate = delegate_contract - cctxt block ~source:contract ~src_pk ~manager_sk ~fee opt_delegate + cctxt block ?confirmations ~source:contract ~src_pk ~src_sk:manager_sk ~fee opt_delegate -let register_as_delegate cctxt block ~fee ~manager_sk src_pk = +let register_as_delegate cctxt block ?confirmations ~fee ~manager_sk src_pk = let source = Signature.Public_key.hash src_pk in delegate_contract - cctxt block - ~source:(Contract.implicit_contract source) ~src_pk ~manager_sk ~fee + cctxt block ?confirmations + ~source:(Contract.implicit_contract source) ~src_pk ~src_sk:manager_sk ~fee (Some source) let source_to_keys (wallet : #Proto_alpha.full) block source = @@ -615,6 +200,8 @@ let save_contract ~force cctxt alias_name contract = return () let originate_contract + (cctxt : #Proto_alpha.full) + block ?confirmations ?branch ~fee ?gas_limit ~delegate @@ -627,94 +214,20 @@ let originate_contract ~src_pk ~src_sk ~code - (cctxt : #Proto_alpha.full) = + () = Lwt.return (Michelson_v1_parser.parse_expression initial_storage) >>= fun result -> Lwt.return (Micheline_parser.no_parsing_error result) >>=? fun { Michelson_v1_parser.expanded = storage } -> - let block = cctxt#block in - Alpha_services.Contract.counter - cctxt block source >>=? fun pcounter -> - let counter = Int32.succ pcounter in - get_branch cctxt block None >>=? fun (_chain_id, branch) -> - Block_services.predecessor cctxt block >>=? fun predecessor -> - begin match gas_limit with - | Some gas_limit -> return gas_limit - | None -> - Alpha_services.Constants.hard_gas_limits cctxt block >>=? fun (_, max_gas) -> - Alpha_services.Forge.Manager.origination cctxt block - ~branch ~source ~sourcePubKey:src_pk ~managerPubKey:manager - ~counter ~balance ~spendable:spendable - ~delegatable ?delegatePubKey:delegate - ~script:{ code ; storage } ~fee ~gas_limit:max_gas () >>=? fun bytes -> - Client_keys.sign - ~watermark:Generic_operation src_sk bytes >>=? fun signature -> - let signed_bytes = Signature.concat bytes signature in - let oph = Operation_hash.hash_bytes [ signed_bytes ] in - Alpha_services.Helpers.apply_operation cctxt block - predecessor oph bytes (Some signature) >>=? fun result -> - Lwt.return (estimated_gas result) >>=? fun gas -> - if Z.equal gas Z.zero then - cctxt#message "Estimated gas: none" >>= fun () -> - return Z.zero - else - cctxt#message "Estimated gas: %s units (will add 100 for safety)" (Z.to_string gas) >>= fun () -> - return (Z.add gas (Z.of_int 100)) - end >>=? fun gas_limit -> - Alpha_services.Forge.Manager.origination cctxt block - ~branch ~source ~sourcePubKey:src_pk ~managerPubKey:manager - ~counter ~balance ~spendable:spendable - ~delegatable ?delegatePubKey:delegate - ~script:{ code ; storage } ~fee ~gas_limit () >>=? fun bytes -> - Client_keys.sign - src_sk ~watermark:Generic_operation bytes >>=? fun signature -> - originate cctxt ~block ~signature bytes - -let wait_for_operation_inclusion - (ctxt : #Proto_alpha.full) - ?(predecessors = 10) - ?(confirmations = 1) - operation_hash = - let confirmed_blocks = Hashtbl.create confirmations in - Block_services.monitor ctxt ~length:predecessors >>=? fun (stream, stop) -> - let stream = Lwt_stream.flatten @@ Lwt_stream.flatten @@ stream in - Lwt_stream.find_s begin fun bi -> - match Hashtbl.find_opt confirmed_blocks bi.Block_services.predecessor with - | Some n -> - ctxt#answer - "Operation received %d confirmations as of block: %a" - (n+1) Block_hash.pp bi.hash >>= fun () -> - if n+1 < confirmations then begin - Hashtbl.add confirmed_blocks bi.hash (n+1) ; - Lwt.return_false - end else - Lwt.return_true - | None -> - Block_services.operations ctxt (`Hash (bi.hash, 0)) >>= fun operations -> - let in_block = - match operations with - | Error _ -> false - | Ok operations -> - List.exists - (List.exists - (fun (hash, _) -> - Operation_hash.equal operation_hash hash)) - operations in - if not in_block then - Lwt.return_false - else begin - ctxt#answer - "Operation found in block: %a" - Block_hash.pp bi.hash >>= fun () -> - if confirmations <= 0 then - Lwt.return_true - else begin - Hashtbl.add confirmed_blocks bi.hash 0 ; - Lwt.return_false - end - end - end stream >>= fun _ -> - stop () ; - return () + let origination = + Origination { manager ; + delegate ; + script = Some { code ; storage } ; + spendable ; + delegatable ; + credit = balance ; + preorigination = None } in + originate cctxt block ?confirmations + ?branch ~source ~src_pk ~src_sk ~fee ?gas_limit origination type activation_key = { pkh : Ed25519.Public_key_hash.t ; @@ -763,13 +276,10 @@ let claim_commitment (cctxt : #Proto_alpha.full) Embedded pkh: %a @]" Signature.Public_key_hash.pp pkh Ed25519.Public_key_hash.pp key.pkh) >>=? fun () -> - let op = [ Activation { id = key.pkh ; secret = key.secret } ] in - Block_services.info cctxt block >>=? fun bi -> - Alpha_services.Forge.Anonymous.operations - cctxt block ~branch:bi.hash op >>=? fun bytes -> - Shell_services.inject_operation - cctxt ~chain_id:bi.chain_id bytes >>=? fun oph -> - operation_submitted_message cctxt oph >>=? fun () -> + let contents = + Anonymous_operations + [ Activation { id = key.pkh ; secret = key.secret } ] in + Injection.inject_operation cctxt ?confirmations block contents >>=? fun (_oph, _op, _result as res) -> let pk_uri = Tezos_signer_backends.Unencrypted.make_pk pk in begin if encrypted then @@ -777,22 +287,21 @@ let claim_commitment (cctxt : #Proto_alpha.full) else return (Tezos_signer_backends.Unencrypted.make_sk sk) end >>=? fun sk_uri -> + Client_keys.register_key cctxt ?force (pkh, pk_uri, sk_uri) name >>=? fun () -> begin match confirmations with | None -> - Client_keys.register_key cctxt ?force (pkh, pk_uri, sk_uri) name >>=? fun () -> return () - | Some confirmations -> - cctxt#message "Waiting for the operation to be included..." >>= fun () -> - wait_for_operation_inclusion ~confirmations cctxt oph >>=? fun () -> - Client_keys.register_key cctxt ?force (pkh, pk_uri, sk_uri) name >>=? fun () -> + | Some _confirmations -> Alpha_services.Contract.balance - cctxt (`Head 0) (Contract.implicit_contract pkh) >>=? fun balance -> + cctxt (`Head 0) + (Contract.implicit_contract pkh) >>=? fun balance -> cctxt#message "Account %s (%a) created with %s%a." name Signature.Public_key_hash.pp pkh Client_proto_args.tez_sym Tez.pp balance >>= fun () -> return () - end + end >>=? fun () -> + return res diff --git a/src/proto_alpha/lib_client/client_proto_context.mli b/src/proto_alpha/lib_client/client_proto_context.mli index a9bc08ca1..c0fbced42 100644 --- a/src/proto_alpha/lib_client/client_proto_context.mli +++ b/src/proto_alpha/lib_client/client_proto_context.mli @@ -37,30 +37,22 @@ val get_balance: val set_delegate : #Proto_alpha.full -> Block_services.block -> + ?confirmations:int -> fee:Tez.tez -> Contract.t -> src_pk:public_key -> manager_sk:Client_keys.sk_uri -> public_key_hash option -> - Operation_list_hash.elt tzresult Lwt.t + Injection.result tzresult Lwt.t val register_as_delegate: #Proto_alpha.full -> Block_services.block -> + ?confirmations:int -> fee:Tez.tez -> manager_sk:Client_keys.sk_uri -> - public_key -> Operation_list_hash.elt tzresult Lwt.t - -val operation_submitted_message : - #Client_context.printer -> - Operation_hash.t -> - unit tzresult Lwt.t - -val pp_internal_operation: - Format.formatter -> internal_operation -> unit - -val pp_operation_result : - Format.formatter -> (operation * Apply_operation_result.operation_result) -> unit + public_key -> + Injection.result tzresult Lwt.t val source_to_keys: #Proto_alpha.full -> @@ -69,6 +61,9 @@ val source_to_keys: (public_key * Client_keys.sk_uri) tzresult Lwt.t val originate_account : + #Proto_alpha.full -> + Block_services.block -> + ?confirmations:int -> ?branch:int -> source:Contract.t -> src_pk:public_key -> @@ -78,9 +73,7 @@ val originate_account : ?delegate:public_key_hash -> balance:Tez.tez -> fee:Tez.tez -> - Block_services.block -> - #Proto_alpha.full -> - unit -> (Operation_list_hash.elt * Contract.t) tzresult Lwt.t + unit -> (Injection.result * Contract.t) tzresult Lwt.t val save_contract : force:bool -> @@ -89,13 +82,11 @@ val save_contract : Contract.t -> unit tzresult Lwt.t -val operation_submitted_message : - #Client_context.printer -> - ?contracts:Contract.t list -> - Operation_hash.t -> - unit tzresult Lwt.t - val originate_contract: + #Proto_alpha.full -> + Block_services.block -> + ?confirmations:int -> + ?branch:int -> fee:Tez.t -> ?gas_limit:Z.t -> delegate:public_key_hash option -> @@ -108,12 +99,12 @@ val originate_contract: src_pk:public_key -> src_sk:Client_keys.sk_uri -> code:Script.expr -> - #Proto_alpha.full -> - (Operation_hash.t * Contract.t) tzresult Lwt.t + unit -> (Injection.result * Contract.t) tzresult Lwt.t val transfer : #Proto_alpha.full -> Block_services.block -> + ?confirmations:int -> ?branch:int -> source:Contract.t -> src_pk:public_key -> @@ -124,31 +115,26 @@ val transfer : fee:Tez.t -> ?gas_limit:Z.t -> unit -> - (Operation_hash.t * Contract.t list) tzresult Lwt.t + (Injection.result * Contract.t list) tzresult Lwt.t val reveal : #Proto_alpha.full -> Block_services.block -> + ?confirmations:int -> ?branch:int -> source:Contract.t -> src_pk:public_key -> src_sk:Client_keys.sk_uri -> fee:Tez.t -> - unit -> Operation_hash.t tzresult Lwt.t + unit -> Injection.result tzresult Lwt.t val dictate : - #Proto_alpha.rpc_context -> - Block_services.block -> - dictator_operation -> - Signature.secret_key -> - Operation_hash.t tzresult Lwt.t - -val wait_for_operation_inclusion: #Proto_alpha.full -> - ?predecessors:int -> + Block_services.block -> ?confirmations:int -> - Operation_hash.t -> - unit tzresult Lwt.t + dictator_operation -> + Client_keys.sk_uri -> + Injection.result tzresult Lwt.t type activation_key = { pkh : Ed25519.Public_key_hash.t ; @@ -169,5 +155,5 @@ val claim_commitment: Block_services.block -> activation_key -> string -> - unit tzresult Lwt.t + Injection.result tzresult Lwt.t diff --git a/src/proto_alpha/lib_client/client_proto_programs.ml b/src/proto_alpha/lib_client/client_proto_programs.ml index 3482fcdd8..485670e03 100644 --- a/src/proto_alpha/lib_client/client_proto_programs.ml +++ b/src/proto_alpha/lib_client/client_proto_programs.ml @@ -58,7 +58,7 @@ let print_run_result (cctxt : #Client_context.printer) ~show_source ~parsed = fu | Ok (storage, operations, maybe_diff) -> cctxt#message "@[@[storage@,%a@]@,@[emitted operations@,%a@]@,@[%a@]@]@." print_expr storage - (Format.pp_print_list Client_proto_context.pp_internal_operation) operations + (Format.pp_print_list Operation_result.pp_internal_operation) operations print_big_map_diff maybe_diff >>= fun () -> return () | Error errs -> @@ -71,7 +71,7 @@ let print_trace_result (cctxt : #Client_context.printer) ~show_source ~parsed = "@[@[storage@,%a@]@,\ @[emitted operations@,%a@]@,%a@[@[trace@,%a@]@]@." print_expr storage - (Format.pp_print_list Client_proto_context.pp_internal_operation) operations + (Format.pp_print_list Operation_result.pp_internal_operation) operations print_big_map_diff maybe_big_map_diff (Format.pp_print_list (fun ppf (loc, gas, stack) -> diff --git a/src/proto_alpha/lib_client/injection.ml b/src/proto_alpha/lib_client/injection.ml new file mode 100644 index 000000000..66405af3f --- /dev/null +++ b/src/proto_alpha/lib_client/injection.ml @@ -0,0 +1,145 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Proto_alpha +open Alpha_context +open Apply_operation_result + +let get_branch rpc_config (block : Block_services.block) branch = + let branch = Option.unopt ~default:0 branch in (* TODO export parameter *) + begin + match block with + | `Head n -> return (`Head (n+branch)) + | `Test_head n -> return (`Test_head (n+branch)) + | `Hash (h,n) -> return (`Hash (h,n+branch)) + | `Genesis -> return `Genesis + end >>=? fun block -> + Block_services.hash rpc_config block >>=? fun hash -> + return hash + +type result = Operation_hash.t * operation * operation_result + +let preapply + cctxt block + ?branch ?src_sk contents = + get_branch cctxt block branch >>=? fun branch -> + let bytes = + Data_encoding.Binary.to_bytes_exn + Operation.unsigned_operation_encoding + ({ branch }, contents) in + let watermark = + match contents with + | Sourced_operations (Consensus_operation (Endorsements _)) -> + Signature.Endorsement + | _ -> + Signature.Generic_operation in + begin + match src_sk with + | None -> return None + | Some src_sk -> + Client_keys.sign + ~watermark src_sk bytes >>=? fun signature -> + return (Some signature) + end >>=? fun signature -> + let op = + { shell = { branch } ; + contents ; + signature } in + let oph = Operation.hash op in + Block_services.hash cctxt block >>=? fun bh -> + Alpha_services.Helpers.apply_operation cctxt + block bh oph bytes signature >>=? fun result -> + return (oph, op, result) + +let estimated_gas = function + | Sourced_operation_result (Manager_operations_result { operation_results }) -> + List.fold_left + (fun acc (_, r) -> acc >>? fun acc -> + match r with + | Applied (Transaction_result { consumed_gas } + | Origination_result { consumed_gas }) -> + Ok (Z.add consumed_gas acc) + | Applied Reveal_result -> Ok acc + | Applied Delegation_result -> Ok acc + | Skipped -> assert false + | Failed errs -> Alpha_environment.wrap_error (Error errs)) + (Ok Z.zero) operation_results + | _ -> Ok Z.zero + +let originated_contracts = function + | Sourced_operation_result (Manager_operations_result { operation_results }) -> + List.fold_left + (fun acc (_, r) -> acc >>? fun acc -> + match r with + | Applied (Transaction_result { originated_contracts } + | Origination_result { originated_contracts }) -> + Ok (originated_contracts @ acc) + | Applied Reveal_result -> Ok acc + | Applied Delegation_result -> Ok acc + | Skipped -> assert false + | Failed errs -> Alpha_environment.wrap_error (Error errs)) + (Ok []) operation_results + | _ -> Ok [] + +let may_patch_gas_limit + (cctxt : #Proto_alpha.full) block ?branch + ?src_sk contents = + Alpha_services.Constants.hard_gas_limits cctxt block >>=? fun (_, gas_limit) -> + match contents with + | Sourced_operations (Manager_operations c) + when c.gas_limit < Z.zero || gas_limit < c.gas_limit -> + let contents = + Sourced_operations (Manager_operations { c with gas_limit }) in + preapply cctxt block ?branch ?src_sk contents >>=? fun (_, _, result) -> + Lwt.return (estimated_gas result) >>=? fun gas -> + begin + if Z.equal gas Z.zero then + cctxt#message "Estimated gas: none" >>= fun () -> + return Z.zero + else + cctxt#message + "Estimated gas: %s units (will add 100 for safety)" + (Z.to_string gas) >>= fun () -> + return (Z.add gas (Z.of_int 100)) + end >>=? fun gas_limit -> + return (Sourced_operations (Manager_operations { c with gas_limit })) + | op -> return op + +let inject_operation + cctxt block + ?confirmations ?branch ?src_sk contents = + may_patch_gas_limit + cctxt block ?branch ?src_sk contents >>=? fun contents -> + preapply cctxt block + ?branch ?src_sk contents >>=? fun (_oph, op, result) -> + let bytes = Data_encoding.Binary.to_bytes_exn Operation.encoding op in + Block_services.chain_id cctxt block >>=? fun chain_id -> + Shell_services.inject_operation cctxt ~chain_id bytes >>=? fun oph -> + cctxt#message "Operation successfully injected in the node." >>= fun () -> + cctxt#message "Operation hash is '%a'." Operation_hash.pp oph >>= fun () -> + begin + match confirmations with + | None -> return () + | Some confirmations -> + cctxt#message "Waiting for the operation to be included..." >>= fun () -> + Client_confirmations.wait_for_operation_inclusion + ~confirmations cctxt oph >>=? fun () -> + return () + end >>=? fun () -> + cctxt#message + "@[This sequence of operations was run:@,%a@]" + Operation_result.pp_operation_result (op, result) >>= fun () -> + Lwt.return (originated_contracts result) >>=? fun contracts -> + Lwt_list.iter_s + (fun c -> + cctxt#message + "New contract %a originated." + Contract.pp c) + contracts >>= fun () -> + return (oph, op, result) diff --git a/src/proto_alpha/lib_client/injection.mli b/src/proto_alpha/lib_client/injection.mli new file mode 100644 index 000000000..053164966 --- /dev/null +++ b/src/proto_alpha/lib_client/injection.mli @@ -0,0 +1,33 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Proto_alpha +open Alpha_context +open Apply_operation_result + +type result = Operation_hash.t * operation * operation_result + +val preapply: + #Proto_alpha.full -> + Block_services.block -> + ?branch:int -> + ?src_sk:Client_keys.sk_uri -> + proto_operation -> + result tzresult Lwt.t + +val inject_operation: + #Proto_alpha.full -> + Block_services.block -> + ?confirmations:int -> + ?branch:int -> + ?src_sk:Client_keys.sk_uri -> + proto_operation -> + result tzresult Lwt.t + +val originated_contracts: operation_result -> Contract.t list tzresult diff --git a/src/proto_alpha/lib_client/operation_result.ml b/src/proto_alpha/lib_client/operation_result.ml new file mode 100644 index 000000000..628a8ea88 --- /dev/null +++ b/src/proto_alpha/lib_client/operation_result.ml @@ -0,0 +1,351 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Proto_alpha +open Alpha_context +open Apply_operation_result + +let pp_manager_operation_content ppf source operation internal pp_result result = + Format.fprintf ppf "@[" ; + begin match operation with + | Alpha_context.Transaction { destination ; amount ; parameters } -> + Format.fprintf ppf + "@[%s:@,\ + Amount: %s%a@,\ + From: %a@,\ + To: %a" + (if internal then "Internal transaction" else "Transaction") + Client_proto_args.tez_sym + Tez.pp amount + Contract.pp source + Contract.pp destination ; + begin match parameters with + | None -> () + | Some expr -> + Format.fprintf ppf + "@,Parameter: @[%a@]" + Michelson_v1_printer.print_expr expr + end ; + pp_result ppf result ; + Format.fprintf ppf "@]" ; + | Origination { manager ; delegate ; credit ; spendable ; delegatable ; script } -> + Format.fprintf ppf "@[%s:@,\ + From: %a@,\ + For: %a@,\ + Credit: %s%a" + (if internal then "Internal origination" else "Origination") + Contract.pp source + Signature.Public_key_hash.pp manager + Client_proto_args.tez_sym + Tez.pp credit ; + begin match script with + | None -> Format.fprintf ppf "@,No script (accepts all transactions)" + | Some { code ; storage } -> + Format.fprintf ppf + "@,@[Script:@ %a\ + @,@[Initial storage:@ %a@]" + Michelson_v1_printer.print_expr code + Michelson_v1_printer.print_expr storage + end ; + begin match delegate with + | None -> Format.fprintf ppf "@,No delegate for this contract" + | Some delegate -> Format.fprintf ppf "@,Delegate: %a" Signature.Public_key_hash.pp delegate + end ; + if spendable then Format.fprintf ppf "@,Spendable by the manager" ; + if delegatable then Format.fprintf ppf "@,Delegate can be changed by the manager" ; + pp_result ppf result ; + Format.fprintf ppf "@]" ; + | Reveal key -> + Format.fprintf ppf + "@[%s of manager public key:@,\ + Contract: %a@,\ + Key: %a%a@]" + (if internal then "Internal revelation" else "Revelation") + Contract.pp source + Signature.Public_key.pp key + pp_result result + | Delegation None -> + Format.fprintf ppf + "@[%s:@,\ + Contract: %a@,\ + To: nobody%a@]" + (if internal then "Internal Delegation" else "Delegation") + Contract.pp source + pp_result result + | Delegation (Some delegate) -> + Format.fprintf ppf + "@[%s:@,\ + Contract: %a@,\ + To: %a%a@]" + (if internal then "Internal Delegation" else "Delegation") + Contract.pp source + Signature.Public_key_hash.pp delegate + pp_result result + end ; + Format.fprintf ppf "@]" + +let pp_balance_updates ppf = function + | [] -> () + | balance_updates -> + let balance_updates = + List.map (fun (balance, update) -> + let balance = match balance with + | Contract c -> + Format.asprintf "%a" Contract.pp c + | Rewards (pkh, l) -> + Format.asprintf "rewards(%a,%a)" + Signature.Public_key_hash.pp pkh Cycle.pp l + | Fees (pkh, l) -> + Format.asprintf "fees(%a,%a)" + Signature.Public_key_hash.pp pkh Cycle.pp l + | Deposits (pkh, l) -> + Format.asprintf "deposits(%a,%a)" + Signature.Public_key_hash.pp pkh Cycle.pp l in + (balance, update)) balance_updates in + let column_size = + List.fold_left + (fun acc (balance, _) -> Compare.Int.max acc (String.length balance)) + 0 balance_updates in + let pp_update ppf = function + | Credited amount -> Format.fprintf ppf "+%s%a" Client_proto_args.tez_sym Tez.pp amount + | Debited amount -> Format.fprintf ppf "-%s%a" Client_proto_args.tez_sym Tez.pp amount in + let pp_one ppf (balance, update) = + let to_fill = column_size + 3 - String.length balance in + let filler = String.make to_fill '.' in + Format.fprintf ppf "%s %s %a" balance filler pp_update update in + Format.fprintf ppf "@[%a@]" + (Format.pp_print_list pp_one) balance_updates + +let pp_operation_result ppf ({ contents ; _ }, operation_result) = + Format.fprintf ppf "@[" ; + begin match contents, operation_result with + | Anonymous_operations ops, Anonymous_operations_result rs -> + let ops_rs = List.combine ops rs in + let pp_anonymous_operation_result ppf = function + | Seed_nonce_revelation { level ; nonce }, + Seed_nonce_revelation_result bus -> + Format.fprintf ppf + "@[Seed nonce revelation:@,\ + Level: %a@,\ + Nonce (hash): %a@,\ + Balance updates:@,\ + \ %a@]" + Raw_level.pp level + Nonce_hash.pp (Nonce.hash nonce) + pp_balance_updates bus + | Double_baking_evidence { bh1 ; bh2 }, + Double_baking_evidence_result bus -> + Format.fprintf ppf + "@[Double baking evidence:@,\ + Exhibit A: %a@,\ + Exhibit B: %a@,\ + Balance updates:@,\ + \ %a@]" + Block_hash.pp (Block_header.hash bh1) + Block_hash.pp (Block_header.hash bh2) + pp_balance_updates bus + | Double_endorsement_evidence { op1 ; op2}, + Double_endorsement_evidence_result bus -> + Format.fprintf ppf + "@[Double endorsement evidence:@,\ + Exhibit A: %a@,\ + Exhibit B: %a@,\ + Balance updates:@,\ + \ %a@]" + Operation_hash.pp (Operation.hash op1) + Operation_hash.pp (Operation.hash op2) + pp_balance_updates bus + | Activation { id ; _ }, + Activation_result bus -> + Format.fprintf ppf + "@[Genesis account activation:@,\ + Account: %a@,\ + Balance updates:@,\ + \ %a@]" + Ed25519.Public_key_hash.pp id + pp_balance_updates bus + | _, _ -> invalid_arg "Apply_operation_result.pp" + in + Format.pp_print_list pp_anonymous_operation_result ppf ops_rs + | Sourced_operations + (Consensus_operation + (Endorsements { block ; level ; slots })), + Sourced_operation_result + (Consensus_operation_result + (Endorsements_result (delegate, _slots))) -> + Format.fprintf ppf + "@[Endorsement:@,\ + Block: %a@,\ + Level: %a@,\ + Delegate: %a@,\ + Slots: %a@]" + Block_hash.pp block + Raw_level.pp level + Signature.Public_key_hash.pp delegate + (Format.pp_print_list + ~pp_sep:Format.pp_print_space + Format.pp_print_int) + slots + | Sourced_operations + (Amendment_operation { source ; operation = Proposals { period ; proposals } }), + Sourced_operation_result Amendment_operation_result -> + Format.fprintf ppf + "@[Proposals:@,\ + From: %a@,\ + Period: %a@,\ + Protocols:@,\ + \ @[%a@]@]" + Signature.Public_key_hash.pp source + Voting_period.pp period + (Format.pp_print_list Protocol_hash.pp) proposals + | Sourced_operations + (Amendment_operation { source ; operation = Ballot { period ; proposal ; ballot } }), + Sourced_operation_result Amendment_operation_result -> + Format.fprintf ppf + "@[Ballot:@,\ + From: %a@,\ + Period: %a@,\ + Protocol: %a@,\ + Vote: %s@]" + Signature.Public_key_hash.pp source + Voting_period.pp period + Protocol_hash.pp proposal + (match ballot with Yay -> "YAY" | Pass -> "PASS" | Nay -> "NAY") + | Sourced_operations (Dictator_operation (Activate protocol)), + Sourced_operation_result Dictator_operation_result -> + Format.fprintf ppf + "@[Dictator protocol activation:@,\ + Protocol: %a@]" + Protocol_hash.pp protocol + | Sourced_operations (Dictator_operation (Activate_testchain protocol)), + Sourced_operation_result Dictator_operation_result -> + Format.fprintf ppf + "@[Dictator test protocol activation:@,\ + Protocol: %a@]" + Protocol_hash.pp protocol + | Sourced_operations (Manager_operations { source ; fee ; counter ; operations ; gas_limit }), + Sourced_operation_result (Manager_operations_result { balance_updates ; operation_results }) -> + let pp_result ppf result = + Format.fprintf ppf "@," ; + match result with + | Skipped -> + Format.fprintf ppf + "This operation was skipped" + | Failed errs -> + Format.fprintf ppf + "@[This operation FAILED with the folllowing error:@,%a@]" + (Format.pp_print_list Alpha_environment.Error_monad.pp) errs + | Applied Reveal_result -> + Format.fprintf ppf + "This revelation was successfully applied" + | Applied Delegation_result -> + Format.fprintf ppf + "This delegation was successfully applied" + | Applied (Transaction_result { balance_updates ; consumed_gas ; + operations ; storage ; + originated_contracts ; storage_fees_increment }) -> + Format.fprintf ppf + "This transaction was successfully applied" ; + begin match operations with + | [] -> () + | ops -> Format.fprintf ppf "@,Internal operations: %d" (List.length ops) + end ; + begin match originated_contracts with + | [] -> () + | contracts -> + Format.fprintf ppf "@,@[Originated contracts:@,%a@]" + (Format.pp_print_list Contract.pp) contracts + end ; + begin match storage with + | None -> () + | Some expr -> + Format.fprintf ppf "@,@[Updated storage:@ %a@]" + Michelson_v1_printer.print_expr expr + end ; + begin if storage_fees_increment <> Tez.zero then + Format.fprintf ppf + "@,Storage fees increment: %s%a" + Client_proto_args.tez_sym + Tez.pp storage_fees_increment + end ; + Format.fprintf ppf + "@,Consumed gas: %s" + (Z.to_string consumed_gas) ; + begin match balance_updates with + | [] -> () + | balance_updates -> + Format.fprintf ppf + "@,Balance updates:@, %a" + pp_balance_updates balance_updates + end + | Applied (Origination_result { balance_updates ; consumed_gas ; + originated_contracts ; storage_fees_increment }) -> + Format.fprintf ppf + "This origination was successfully applied" ; + begin match originated_contracts with + | [] -> () + | contracts -> + Format.fprintf ppf "@,@[Originated contracts:@,%a@]" + (Format.pp_print_list Contract.pp) contracts + end ; + begin if storage_fees_increment <> Tez.zero then + Format.fprintf ppf + "@,Storage fees increment: %s%a" + Client_proto_args.tez_sym + Tez.pp storage_fees_increment + end ; + Format.fprintf ppf + "@,Consumed gas: %s" + (Z.to_string consumed_gas) ; + begin match balance_updates with + | [] -> () + | balance_updates -> + Format.fprintf ppf + "@,Balance updates:@, %a" + pp_balance_updates balance_updates + end in + let rec pp_manager_operations_results ppf = function + | [], [] -> () + | operation :: ops, (External, r) :: rs -> + Format.fprintf ppf "@," ; + pp_manager_operation_content ppf source operation false pp_result r ; + pp_manager_operations_results ppf (ops, rs) + | ops, (Internal { source ; operation }, r) :: rs -> + Format.fprintf ppf "@," ; + pp_manager_operation_content ppf source operation true pp_result r ; + pp_manager_operations_results ppf (ops, rs) + | [], _ :: _ + | _ :: _, [] -> invalid_arg "Apply_operation_result.pp" in + Format.fprintf ppf + "@[@[Manager signed operations:@,\ + From: %a@,\ + Fee to the baker: %s%a@,\ + Expected counter: %ld@,\ + Gas limit: %s" + Contract.pp source + Client_proto_args.tez_sym + Tez.pp fee + counter + (Z.to_string gas_limit) ; + begin match balance_updates with + | [] -> () + | balance_updates -> + Format.fprintf ppf + "@,Balance updates:@, %a" + pp_balance_updates balance_updates + end ; + Format.fprintf ppf + "@]%a@]" + pp_manager_operations_results (operations, operation_results) + | _, _ -> invalid_arg "Apply_operation_result.pp" + end ; + Format.fprintf ppf "@]" + +let pp_internal_operation ppf { source ; operation } = + pp_manager_operation_content ppf source operation true (fun _ppf () -> ()) () diff --git a/src/proto_alpha/lib_client/operation_result.mli b/src/proto_alpha/lib_client/operation_result.mli new file mode 100644 index 000000000..7853e6531 --- /dev/null +++ b/src/proto_alpha/lib_client/operation_result.mli @@ -0,0 +1,17 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Proto_alpha +open Alpha_context + +val pp_internal_operation: + Format.formatter -> internal_operation -> unit + +val pp_operation_result: + Format.formatter -> (operation * Apply_operation_result.operation_result) -> unit diff --git a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml index 90c12b628..0264069af 100644 --- a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml +++ b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml @@ -141,8 +141,8 @@ let commands () = @@ stop) begin fun fee (_, contract) (_, delegate) (cctxt : Proto_alpha.full) -> source_to_keys cctxt cctxt#block contract >>=? fun (src_pk, manager_sk) -> - set_delegate ~fee cctxt cctxt#block contract (Some delegate) ~src_pk ~manager_sk >>=? fun oph -> - operation_submitted_message cctxt oph + set_delegate cctxt cctxt#block contract (Some delegate) ~fee ~src_pk ~manager_sk >>=? fun _ -> + return () end ; command ~group ~desc: "Withdraw the delegate from a contract." @@ -152,8 +152,8 @@ let commands () = @@ stop) begin fun fee (_, contract) (cctxt : Proto_alpha.full) -> source_to_keys cctxt cctxt#block contract >>=? fun (src_pk, manager_sk) -> - set_delegate ~fee cctxt cctxt#block contract None ~src_pk ~manager_sk >>=? fun oph -> - operation_submitted_message cctxt oph + set_delegate ~fee cctxt cctxt#block contract None ~src_pk ~manager_sk >>=? fun _ -> + return () end ; command ~group ~desc:"Open a new account." @@ -176,6 +176,8 @@ let commands () = RawContractAlias.of_fresh cctxt force new_contract >>=? fun alias_name -> source_to_keys cctxt cctxt#block source >>=? fun (src_pk, src_sk) -> originate_account + cctxt + cctxt#block ~fee ?delegate ~delegatable @@ -184,11 +186,9 @@ let commands () = ~source ~src_pk ~src_sk - cctxt#block - cctxt - () >>=? fun (oph, contract) -> + () >>=? fun (_res, contract) -> save_contract ~force cctxt alias_name contract >>=? fun () -> - operation_submitted_message ~contracts:[ contract ] cctxt oph + return () end ; command ~group ~desc: "Launch a smart contract on the blockchain." @@ -217,14 +217,14 @@ let commands () = RawContractAlias.of_fresh cctxt force alias_name >>=? fun alias_name -> Lwt.return (Micheline_parser.no_parsing_error program) >>=? fun { expanded = code } -> source_to_keys cctxt cctxt#block source >>=? fun (src_pk, src_sk) -> - originate_contract ~fee ?gas_limit ~delegate ~delegatable ~spendable ~initial_storage - ~manager ~balance ~source ~src_pk ~src_sk ~code cctxt >>= fun errors -> + originate_contract cctxt cctxt#block + ~fee ?gas_limit ~delegate ~delegatable ~spendable ~initial_storage + ~manager ~balance ~source ~src_pk ~src_sk ~code () >>= fun errors -> report_michelson_errors ~no_print_source ~msg:"origination simulation failed" cctxt errors >>= function | None -> return () - | Some (oph, contract) -> + | Some (_res, contract) -> save_contract ~force cctxt alias_name contract >>=? fun () -> - operation_submitted_message cctxt - ~contracts:[contract] oph + return () end ; command ~group ~desc: "Transfer tokens / call a smart contract." @@ -245,8 +245,8 @@ let commands () = ~source ~src_pk ~src_sk ~destination ~arg ~amount ?gas_limit () >>= report_michelson_errors ~no_print_source ~msg:"transfer simulation failed" cctxt >>= function | None -> return () - | Some (oph, contracts) -> - operation_submitted_message cctxt ~contracts oph + | Some (_res, _contracts) -> + return () end; command ~group ~desc: "Reveal the public key of the contract manager." @@ -258,8 +258,8 @@ let commands () = begin fun fee (_, source) cctxt -> source_to_keys cctxt cctxt#block source >>=? fun (src_pk, src_sk) -> reveal cctxt ~fee cctxt#block - ~source ~src_pk ~src_sk () >>=? fun oph -> - operation_submitted_message cctxt oph + ~source ~src_pk ~src_sk () >>=? fun _res -> + return () end; command ~group ~desc: "Register the public key hash as a delegate." @@ -272,8 +272,8 @@ let commands () = begin fun fee src_pkh cctxt -> Client_keys.get_key cctxt src_pkh >>=? fun (_, src_pk, src_sk) -> register_as_delegate cctxt - ~fee cctxt#block ~manager_sk:src_sk src_pk >>=? fun oph -> - operation_submitted_message cctxt oph + ~fee cctxt#block ~manager_sk:src_sk src_pk >>=? fun _res -> + return () end; command ~group ~desc:"Register and activate a predefined account using the provided activation key." @@ -288,24 +288,23 @@ let commands () = ~desc:"Activation key (as JSON file) obtained from the Tezos foundation (or the Alphanet faucet)." file_parameter @@ stop) - (fun - (force, no_confirmation, encrypted) - name activation_key_file cctxt -> - Secret_key.of_fresh cctxt force name >>=? fun name -> - Lwt_utils_unix.Json.read_file activation_key_file >>=? fun json -> - match Data_encoding.Json.destruct - Client_proto_context.activation_key_encoding - json with - | exception (Data_encoding.Json.Cannot_destruct _ as exn) -> - Format.kasprintf (fun s -> failwith "%s" s) - "Invalid activation file: %a %a" - (fun ppf -> Data_encoding.Json.print_error ppf) exn - Data_encoding.Json.pp json - | key -> - let confirmations = - if no_confirmation then None else Some 0 in - claim_commitment cctxt cctxt#block - ~encrypted ?confirmations ~force key name + (fun (force, no_confirmation, encrypted) name activation_key_file cctxt -> + Secret_key.of_fresh cctxt force name >>=? fun name -> + Lwt_utils_unix.Json.read_file activation_key_file >>=? fun json -> + match Data_encoding.Json.destruct + Client_proto_context.activation_key_encoding + json with + | exception (Data_encoding.Json.Cannot_destruct _ as exn) -> + Format.kasprintf (fun s -> failwith "%s" s) + "Invalid activation file: %a %a" + (fun ppf -> Data_encoding.Json.print_error ppf) exn + Data_encoding.Json.pp json + | key -> + let confirmations = + if no_confirmation then None else Some 0 in + claim_commitment cctxt cctxt#block ?confirmations + ~encrypted ~force key name >>=? fun _res -> + return () ); command ~group:alphanet ~desc: "Activate a protocol (Alphanet dictator only)." @@ -314,13 +313,13 @@ let commands () = @@ Protocol_hash.param ~name:"version" ~desc:"protocol version (b58check)" @@ prefixes [ "with" ; "key" ] - @@ Signature.Secret_key.param + @@ Client_keys.Secret_key.source_param ~name:"password" ~desc:"dictator's key" @@ stop) begin fun () hash seckey cctxt -> dictate cctxt cctxt#block - (Activate hash) seckey >>=? fun oph -> - operation_submitted_message cctxt oph + (Activate hash) seckey >>=? fun _ -> + return () end ; command ~desc:"Wait until an operation is included in a block" @@ -358,7 +357,7 @@ let commands () = (failure "confirmations cannot be negative") >>=? fun () -> fail_when (predecessors < 0) (failure "check-previous cannot be negative") >>=? fun () -> - wait_for_operation_inclusion ctxt + Client_confirmations.wait_for_operation_inclusion ctxt ~confirmations ~predecessors operation_hash end ; @@ -368,13 +367,13 @@ let commands () = @@ Protocol_hash.param ~name:"version" ~desc:"protocol version (b58check)" @@ prefixes [ "with" ; "key" ] - @@ Signature.Secret_key.param + @@ Client_keys.Secret_key.source_param ~name:"password" ~desc:"dictator's key" @@ stop) begin fun () hash seckey cctxt -> dictate cctxt cctxt#block - (Activate_testchain hash) seckey >>=? fun oph -> - operation_submitted_message cctxt oph + (Activate_testchain hash) seckey >>=? fun _res -> + return () end ; ]