(**************************************************************************) (* *) (* 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 () -> ()) ()