From 7c8e0403e3e2133c993d383716b808d1fa3e4da6 Mon Sep 17 00:00:00 2001 From: Benjamin Canou Date: Wed, 6 Jun 2018 12:05:57 +0200 Subject: [PATCH] Alpha: minor cleanup of Apply for better readability --- .../lib_protocol/src/alpha_context.ml | 1 + .../lib_protocol/src/alpha_context.mli | 3 +- src/proto_alpha/lib_protocol/src/apply.ml | 69 ++----------------- .../src/apply_operation_result.ml | 6 ++ .../src/apply_operation_result.mli | 3 + .../lib_protocol/src/contract_repr.ml | 9 ++- .../lib_protocol/src/contract_repr.mli | 2 +- .../lib_protocol/src/contract_storage.ml | 9 +-- .../lib_protocol/src/contract_storage.mli | 4 +- src/proto_alpha/lib_protocol/src/main.ml | 43 +++++++++++- .../lib_protocol/src/raw_context.ml | 4 ++ .../lib_protocol/src/raw_context.mli | 1 + 12 files changed, 80 insertions(+), 74 deletions(-) diff --git a/src/proto_alpha/lib_protocol/src/alpha_context.ml b/src/proto_alpha/lib_protocol/src/alpha_context.ml index 982005841..5139efde3 100644 --- a/src/proto_alpha/lib_protocol/src/alpha_context.ml +++ b/src/proto_alpha/lib_protocol/src/alpha_context.ml @@ -73,6 +73,7 @@ module Gas = struct let set_unlimited = Raw_context.set_gas_unlimited let consume = Raw_context.consume_gas let level = Raw_context.gas_level + let consumed = Raw_context.gas_consumed let block_level = Raw_context.block_gas_level end module Level = struct diff --git a/src/proto_alpha/lib_protocol/src/alpha_context.mli b/src/proto_alpha/lib_protocol/src/alpha_context.mli index 954fe1132..d049b8164 100644 --- a/src/proto_alpha/lib_protocol/src/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/src/alpha_context.mli @@ -140,6 +140,7 @@ module Gas : sig val set_unlimited: context -> context val consume: context -> cost -> context tzresult val level: context -> t + val consumed: since: context -> until: context -> Z.t val block_level: context -> Z.t end @@ -526,7 +527,7 @@ module Contract : sig val init_origination_nonce: context -> Operation_hash.t -> context val unset_origination_nonce: context -> context val fresh_contract_from_current_nonce : context -> (context * t) tzresult Lwt.t - val originated_from_current_nonce: context -> contract list tzresult Lwt.t + val originated_from_current_nonce: since: context -> until:context -> contract list tzresult Lwt.t type big_map_diff = (string * Script.expr option) list diff --git a/src/proto_alpha/lib_protocol/src/apply.ml b/src/proto_alpha/lib_protocol/src/apply.ml index c18660141..6449ecf68 100644 --- a/src/proto_alpha/lib_protocol/src/apply.ml +++ b/src/proto_alpha/lib_protocol/src/apply.ml @@ -328,22 +328,6 @@ let () = open Apply_operation_result -let gas_difference ctxt_before ctxt_after = - match Gas.level ctxt_before, Gas.level ctxt_after with - | Limited { remaining = before }, Limited { remaining = after } -> Z.sub before after - | _ -> Z.zero - -let new_contracts ctxt_before ctxt_after = - Contract.originated_from_current_nonce ctxt_before >>=? fun before -> - Contract.originated_from_current_nonce ctxt_after >>=? fun after -> - return (List.filter (fun c -> not (List.exists (Contract.equal c) before)) after) - -let cleanup_balance_updates balance_updates = - List.filter - (fun (_, (Credited update | Debited update)) -> - not (Tez.equal update Tez.zero)) - balance_updates - let apply_manager_operation_content : type kind. ( Alpha_context.t -> Script_ir_translator.unparsing_mode -> payer:Contract.t -> source:Contract.t -> @@ -383,7 +367,7 @@ let apply_manager_operation_content : [ Contract source, Debited amount ; Contract destination, Credited amount ] ; originated_contracts = [] ; - consumed_gas = gas_difference before_operation ctxt ; + consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt ; storage_size_diff = 0L } in return (ctxt, result, []) | Some script -> @@ -410,7 +394,9 @@ let apply_manager_operation_content : ctxt destination storage big_map_diff >>=? fun ctxt -> Fees.update_script_storage ctxt ~payer destination >>=? fun (ctxt, new_size, fees) -> - new_contracts before_operation ctxt >>=? fun originated_contracts -> + Contract.originated_from_current_nonce + ~since: before_operation + ~until: ctxt >>=? fun originated_contracts -> let result = Transaction_result { storage = Some storage ; @@ -420,7 +406,7 @@ let apply_manager_operation_content : Contract source, Debited amount ; Contract destination, Credited amount ] ; originated_contracts ; - consumed_gas = gas_difference before_operation ctxt ; + consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt ; storage_size_diff = Int64.sub new_size old_size } in return (ctxt, result, operations) end @@ -451,7 +437,7 @@ let apply_manager_operation_content : Contract source, Debited credit ; Contract contract, Credited credit ] ; originated_contracts = [ contract ] ; - consumed_gas = gas_difference before_operation ctxt ; + consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt ; storage_size_diff = size } in return (ctxt, result, []) | Delegation delegate -> @@ -855,46 +841,3 @@ let finalize_application ctxt protocol_data delegate = may_start_new_cycle ctxt >>=? fun ctxt -> Amendment.may_start_new_voting_cycle ctxt >>=? fun ctxt -> return ctxt - -let compare_operations op1 op2 = - let Operation_data op1 = op1.protocol_data in - let Operation_data op2 = op2.protocol_data in - match op1.contents, op2.contents with - | Single (Endorsements _), Single (Endorsements _) -> 0 - | _, Single (Endorsements _) -> 1 - | Single (Endorsements _), _ -> -1 - - | Single (Seed_nonce_revelation _), Single (Seed_nonce_revelation _) -> 0 - | _, Single (Seed_nonce_revelation _) -> 1 - | Single (Seed_nonce_revelation _), _ -> -1 - - | Single (Double_endorsement_evidence _), Single (Double_endorsement_evidence _) -> 0 - | _, Single (Double_endorsement_evidence _) -> 1 - | Single (Double_endorsement_evidence _), _ -> -1 - - | Single (Double_baking_evidence _), Single (Double_baking_evidence _) -> 0 - | _, Single (Double_baking_evidence _) -> 1 - | Single (Double_baking_evidence _), _ -> -1 - - | Single (Activate_account _), Single (Activate_account _) -> 0 - | _, Single (Activate_account _) -> 1 - | Single (Activate_account _), _ -> -1 - - | Single (Proposals _), Single (Proposals _) -> 0 - | _, Single (Proposals _) -> 1 - | Single (Proposals _), _ -> -1 - - | Single (Ballot _), Single (Ballot _) -> 0 - | _, Single (Ballot _) -> 1 - | Single (Ballot _), _ -> -1 - - (* Manager operations with smaller counter are pre-validated first. *) - | Single (Manager_operation op1), Single (Manager_operation op2) -> - Int32.compare op1.counter op2.counter - | Cons (Manager_operation op1, _), Single (Manager_operation op2) -> - Int32.compare op1.counter op2.counter - | Single (Manager_operation op1), Cons (Manager_operation op2, _) -> - Int32.compare op1.counter op2.counter - | Cons (Manager_operation op1, _), Cons (Manager_operation op2, _) -> - Int32.compare op1.counter op2.counter - diff --git a/src/proto_alpha/lib_protocol/src/apply_operation_result.ml b/src/proto_alpha/lib_protocol/src/apply_operation_result.ml index 306f46cde..60dc5f3b0 100644 --- a/src/proto_alpha/lib_protocol/src/apply_operation_result.ml +++ b/src/proto_alpha/lib_protocol/src/apply_operation_result.ml @@ -95,6 +95,12 @@ let balance_update_encoding = type balance_updates = (balance * balance_update) list +let cleanup_balance_updates balance_updates = + List.filter + (fun (_, (Credited update | Debited update)) -> + not (Tez.equal update Tez.zero)) + balance_updates + let balance_updates_encoding = def "operation_metadata.alpha.balance_updates" @@ list (merge_objs balance_encoding balance_update_encoding) diff --git a/src/proto_alpha/lib_protocol/src/apply_operation_result.mli b/src/proto_alpha/lib_protocol/src/apply_operation_result.mli index 39f1ceefc..f2f8330ff 100644 --- a/src/proto_alpha/lib_protocol/src/apply_operation_result.mli +++ b/src/proto_alpha/lib_protocol/src/apply_operation_result.mli @@ -29,6 +29,9 @@ type balance_update = (** A list of balance updates. Duplicates may happen. *) type balance_updates = (balance * balance_update) list +(** Remove zero-valued balances from a list of updates. *) +val cleanup_balance_updates : balance_updates -> balance_updates + (** Result of applying a {!Operation.t}. Follows the same structure. *) type 'kind operation_metadata = { contents: 'kind contents_result_list ; diff --git a/src/proto_alpha/lib_protocol/src/contract_repr.ml b/src/proto_alpha/lib_protocol/src/contract_repr.ml index 2f33ab9ba..d4bd7ae27 100644 --- a/src/proto_alpha/lib_protocol/src/contract_repr.ml +++ b/src/proto_alpha/lib_protocol/src/contract_repr.ml @@ -120,16 +120,19 @@ let originated_contract nonce = Data_encoding.Binary.to_bytes_exn origination_nonce_encoding nonce in Originated (Contract_hash.hash_bytes [data]) -let originated_contracts ({ origination_index } as origination_nonce) = +let originated_contracts + ~since: { origination_index = first ; operation_hash = first_hash } + ~until: ({ origination_index = last ; operation_hash = last_hash } as origination_nonce) = + assert (Operation_hash.equal first_hash last_hash) ; let rec contracts acc origination_index = - if Compare.Int32.(origination_index < 0l) then + if Compare.Int32.(origination_index < first) then acc else let origination_nonce = { origination_nonce with origination_index } in let acc = originated_contract origination_nonce :: acc in contracts acc (Int32.pred origination_index) in - contracts [] (Int32.pred origination_index) + contracts [] (Int32.pred last) let initial_origination_nonce operation_hash = { operation_hash ; origination_index = 0l } diff --git a/src/proto_alpha/lib_protocol/src/contract_repr.mli b/src/proto_alpha/lib_protocol/src/contract_repr.mli index 178baeb18..d55f049e3 100644 --- a/src/proto_alpha/lib_protocol/src/contract_repr.mli +++ b/src/proto_alpha/lib_protocol/src/contract_repr.mli @@ -31,7 +31,7 @@ type origination_nonce val originated_contract : origination_nonce -> contract -val originated_contracts : origination_nonce -> contract list +val originated_contracts : since: origination_nonce -> until: origination_nonce -> contract list val initial_origination_nonce : Operation_hash.t -> origination_nonce diff --git a/src/proto_alpha/lib_protocol/src/contract_storage.ml b/src/proto_alpha/lib_protocol/src/contract_storage.ml index af0966f86..f311a5dc4 100644 --- a/src/proto_alpha/lib_protocol/src/contract_storage.ml +++ b/src/proto_alpha/lib_protocol/src/contract_storage.ml @@ -277,13 +277,14 @@ let fresh_contract_from_current_nonce c = Lwt.return (Raw_context.increment_origination_nonce c) >>=? fun (c, nonce) -> return (c, Contract_repr.originated_contract nonce) -let originated_from_current_nonce ctxt = - Lwt.return (Raw_context.origination_nonce ctxt) >>=? fun nonce -> +let originated_from_current_nonce ~since: ctxt_since ~until: ctxt_until = + Lwt.return (Raw_context.origination_nonce ctxt_since) >>=? fun since -> + Lwt.return (Raw_context.origination_nonce ctxt_until) >>=? fun until -> filter_map_s - (fun contract -> exists ctxt contract >>=? function + (fun contract -> exists ctxt_until contract >>=? function | true -> return (Some contract) | false -> return None) - (Contract_repr.originated_contracts nonce) + (Contract_repr.originated_contracts ~since ~until) let check_counter_increment c contract counter = Storage.Contract.Counter.get c contract >>=? fun contract_counter -> diff --git a/src/proto_alpha/lib_protocol/src/contract_storage.mli b/src/proto_alpha/lib_protocol/src/contract_storage.mli index 37a53d4e2..b755fe9ef 100644 --- a/src/proto_alpha/lib_protocol/src/contract_storage.mli +++ b/src/proto_alpha/lib_protocol/src/contract_storage.mli @@ -95,7 +95,9 @@ val originate: val fresh_contract_from_current_nonce : Raw_context.t -> (Raw_context.t * Contract_repr.t) tzresult Lwt.t val originated_from_current_nonce : - Raw_context.t -> Contract_repr.t list tzresult Lwt.t + since: Raw_context.t -> + until: Raw_context.t -> + Contract_repr.t list tzresult Lwt.t val init: Raw_context.t -> Raw_context.t tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/src/main.ml b/src/proto_alpha/lib_protocol/src/main.ml index 862eddb9b..a505175f1 100644 --- a/src/proto_alpha/lib_protocol/src/main.ml +++ b/src/proto_alpha/lib_protocol/src/main.ml @@ -174,7 +174,48 @@ let finalize_block { mode ; ctxt ; op_count } = let ctxt = Alpha_context.finalize ~commit_message ctxt in return (ctxt, { Alpha_context.Block_header.baker ; level ; voting_period_kind }) -let compare_operations = Apply.compare_operations +let compare_operations op1 op2 = + let open Alpha_context in + let Operation_data op1 = op1.protocol_data in + let Operation_data op2 = op2.protocol_data in + match op1.contents, op2.contents with + | Single (Endorsements _), Single (Endorsements _) -> 0 + | _, Single (Endorsements _) -> 1 + | Single (Endorsements _), _ -> -1 + + | Single (Seed_nonce_revelation _), Single (Seed_nonce_revelation _) -> 0 + | _, Single (Seed_nonce_revelation _) -> 1 + | Single (Seed_nonce_revelation _), _ -> -1 + + | Single (Double_endorsement_evidence _), Single (Double_endorsement_evidence _) -> 0 + | _, Single (Double_endorsement_evidence _) -> 1 + | Single (Double_endorsement_evidence _), _ -> -1 + + | Single (Double_baking_evidence _), Single (Double_baking_evidence _) -> 0 + | _, Single (Double_baking_evidence _) -> 1 + | Single (Double_baking_evidence _), _ -> -1 + + | Single (Activate_account _), Single (Activate_account _) -> 0 + | _, Single (Activate_account _) -> 1 + | Single (Activate_account _), _ -> -1 + + | Single (Proposals _), Single (Proposals _) -> 0 + | _, Single (Proposals _) -> 1 + | Single (Proposals _), _ -> -1 + + | Single (Ballot _), Single (Ballot _) -> 0 + | _, Single (Ballot _) -> 1 + | Single (Ballot _), _ -> -1 + + (* Manager operations with smaller counter are pre-validated first. *) + | Single (Manager_operation op1), Single (Manager_operation op2) -> + Int32.compare op1.counter op2.counter + | Cons (Manager_operation op1, _), Single (Manager_operation op2) -> + Int32.compare op1.counter op2.counter + | Single (Manager_operation op1), Cons (Manager_operation op2, _) -> + Int32.compare op1.counter op2.counter + | Cons (Manager_operation op1, _), Cons (Manager_operation op2, _) -> + Int32.compare op1.counter op2.counter let init ctxt block_header = let level = block_header.Block_header.level in diff --git a/src/proto_alpha/lib_protocol/src/raw_context.ml b/src/proto_alpha/lib_protocol/src/raw_context.ml index 52411e931..ea1523456 100644 --- a/src/proto_alpha/lib_protocol/src/raw_context.ml +++ b/src/proto_alpha/lib_protocol/src/raw_context.ml @@ -154,6 +154,10 @@ let consume_gas ctxt cost = ok { ctxt with block_gas ; operation_gas } let gas_level ctxt = ctxt.operation_gas let block_gas_level ctxt = ctxt.block_gas +let gas_consumed ~since ~until = + match gas_level since, gas_level until with + | Limited { remaining = before }, Limited { remaining = after } -> Z.sub before after + | _, _ -> Z.zero type error += Storage_limit_too_high (* `Permanent *) diff --git a/src/proto_alpha/lib_protocol/src/raw_context.mli b/src/proto_alpha/lib_protocol/src/raw_context.mli index 3ca1e0fc5..4dee452fd 100644 --- a/src/proto_alpha/lib_protocol/src/raw_context.mli +++ b/src/proto_alpha/lib_protocol/src/raw_context.mli @@ -83,6 +83,7 @@ type error += Gas_limit_too_high (* `Permanent *) val set_gas_limit: t -> Z.t -> t tzresult val set_gas_unlimited: t -> t val gas_level: t -> Gas_limit_repr.t +val gas_consumed: since: t -> until: t -> Z.t val block_gas_level: t -> Z.t type error += Storage_limit_too_high (* `Permanent *)