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

Client/Alpha: split module Client_proto_context

Browse Source
This commit is contained in:
Grégoire Henry 2018-04-22 10:50:34 +02:00
parent a11e0000e7
commit 72e31287d1
11 changed files with 827 additions and 702 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
src/lib_client_base/client_confirmations.ml Normal file
View File

@ -0,0 +1,67 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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 ()

15
src/lib_client_base/client_confirmations.mli Normal file
View File

@ -0,0 +1,15 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

13
src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml
View File

@ -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

737
src/proto_alpha/lib_client/client_proto_context.ml
View File

@ -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 "@[<v 0>" ;
begin match operation with
| Alpha_context.Transaction { destination ; amount ; parameters } ->
Format.fprintf ppf
"@[<v 2>%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: @[<v 0>%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 "@[<v 2>%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
"@,@[<hv 2>Script:@ %a\
@,@[<hv 2>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
"@[<v 2>%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
"@[<v 2>%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
"@[<v 2>%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 "@[<v 0>%a@]"
(Format.pp_print_list pp_one) balance_updates
let pp_operation_result ppf ({ contents ; _ }, operation_result) =
Format.fprintf ppf "@[<v 0>" ;
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
"@[<v 2>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
"@[<v 2>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
"@[<v 2>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
"@[<v 2>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
"@[<v 2>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
"@[<v 2>Proposals:@,\
From: %a@,\
Period: %a@,\
Protocols:@,\
\ @[<v 0>%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
"@[<v 2>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
"@[<v 2>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
"@[<v 2>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
"@[<v 2>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 "@,@[<v 2>Originated contracts:@,%a@]"
(Format.pp_print_list Contract.pp) contracts
end ;
begin match storage with
| None -> ()
| Some expr ->
Format.fprintf ppf "@,@[<hv 2>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 "@,@[<v 2>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
"@[<v 0>@[<v 2>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
"@[<v 2>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
"@[<v 2>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

60
src/proto_alpha/lib_client/client_proto_context.mli
View File

@ -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

4
src/proto_alpha/lib_client/client_proto_programs.ml
View File

@ -58,7 +58,7 @@ let print_run_result (cctxt : #Client_context.printer) ~show_source ~parsed = fu
| Ok (storage, operations, maybe_diff) ->
cctxt#message "@[<v 0>@[<v 2>storage@,%a@]@,@[<v 2>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 =
"@[<v 0>@[<v 2>storage@,%a@]@,\
@[<v 2>emitted operations@,%a@]@,%a@[<v 2>@[<v 2>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) ->

145
src/proto_alpha/lib_client/injection.ml Normal file
View File

@ -0,0 +1,145 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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
"@[<v 2>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)

33
src/proto_alpha/lib_client/injection.mli Normal file
View File

@ -0,0 +1,33 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

351
src/proto_alpha/lib_client/operation_result.ml Normal file
View File

@ -0,0 +1,351 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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 "@[<v 0>" ;
begin match operation with
| Alpha_context.Transaction { destination ; amount ; parameters } ->
Format.fprintf ppf
"@[<v 2>%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: @[<v 0>%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 "@[<v 2>%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
"@,@[<hv 2>Script:@ %a\
@,@[<hv 2>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
"@[<v 2>%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
"@[<v 2>%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
"@[<v 2>%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 "@[<v 0>%a@]"
(Format.pp_print_list pp_one) balance_updates
let pp_operation_result ppf ({ contents ; _ }, operation_result) =
Format.fprintf ppf "@[<v 0>" ;
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
"@[<v 2>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
"@[<v 2>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
"@[<v 2>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
"@[<v 2>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
"@[<v 2>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
"@[<v 2>Proposals:@,\
From: %a@,\
Period: %a@,\
Protocols:@,\
\ @[<v 0>%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
"@[<v 2>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
"@[<v 2>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
"@[<v 2>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
"@[<v 2>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 "@,@[<v 2>Originated contracts:@,%a@]"
(Format.pp_print_list Contract.pp) contracts
end ;
begin match storage with
| None -> ()
| Some expr ->
Format.fprintf ppf "@,@[<hv 2>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 "@,@[<v 2>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
"@[<v 0>@[<v 2>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 () -> ()) ()

17
src/proto_alpha/lib_client/operation_result.mli Normal file
View File

@ -0,0 +1,17 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

87
src/proto_alpha/lib_client_commands/client_proto_context_commands.ml
View File

@ -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 ;
]