Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Source file legacy_prevalidator_classification.ml
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547(*****************************************************************************)(* *)(* Open Source License *)(* Copyright (c) 2021-2022 Nomadic Labs, <contact@nomadic-labs.com> *)(* *)(* Permission is hereby granted, free of charge, to any person obtaining a *)(* copy of this software and associated documentation files (the "Software"),*)(* to deal in the Software without restriction, including without limitation *)(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)(* and/or sell copies of the Software, and to permit persons to whom the *)(* Software is furnished to do so, subject to the following conditions: *)(* *)(* The above copyright notice and this permission notice shall be included *)(* in all copies or substantial portions of the Software. *)(* *)(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)(* DEALINGS IN THE SOFTWARE. *)(* *)(*****************************************************************************)(* FIXME: https://gitlab.com/tezos/tezos/-/issues/4113
This file is part of the implementation of the legacy mempool,
which is compatible with Kathmandu and therefore usable on Mainnet.
This file should be removed once Lima has been activated on Mainnet.
When you modify this file, consider whether you should also change
the files that implement the more recent mempool for Lima and newer
protocols. *)modulePrevalidation=Legacy_prevalidationmoduleEvent=structletsection=["legacy_prevalidator_classification"]includeInternal_event.Simpleletpredecessor_less_block=declare_1~section~name:"predecessor_less_block"~msg:"Observing that a parent of block {blk_h} has no predecessor"~level:Warning("blk_h",Block_hash.encoding)endtypeerror_classification=[`Branch_delayedoftztrace|`Branch_refusedoftztrace|`Refusedoftztrace|`Outdatedoftztrace]typeclassification=[`Applied|`Prechecked|error_classification]moduleMap=Operation_hash.MapmoduleSized_map=Tezos_base.Sized.MakeSizedMap(Map)(** This type wraps together:
- a bounded ring of keys (size book-keeping)
- a regular (unbounded) map of key/values (efficient read)
All operations must maintain integrity between the 2!
*)type'protocol_databounded_map={ring:Operation_hash.tRingo.Ring.t;mutablemap:('protocol_dataPrevalidation.operation*errorlist)Map.t;}letmapbounded_map=bounded_map.mapletcardinalbounded_map=Ringo.Ring.lengthbounded_map.ring(** [mk_empty_bounded_map ring_size] returns a {!bounded_map} whose ring
holds at most [ring_size] values. {!Invalid_argument} is raised
if [ring_size <= 0]. *)letmk_empty_bounded_mapring_size={ring=Ringo.Ring.createring_size;map=Map.empty}typeparameters={map_size_limit:int;on_discarded_operation:Operation_hash.t->unit;}(** Note that [applied] and [in_mempool] are intentionally unbounded.
See the mli for detailed documentation.
All operations must maintain the invariant about [in_mempool]
described in the mli. *)type'protocol_datat={parameters:parameters;refused:'protocol_databounded_map;outdated:'protocol_databounded_map;branch_refused:'protocol_databounded_map;branch_delayed:'protocol_databounded_map;mutableapplied_rev:'protocol_dataPrevalidation.operationlist;mutableprechecked:'protocol_dataPrevalidation.operationSized_map.t;mutableunparsable:Operation_hash.Set.t;mutablein_mempool:('protocol_dataPrevalidation.operation*classification)Map.t;}letcreateparameters={parameters;refused=mk_empty_bounded_mapparameters.map_size_limit;outdated=mk_empty_bounded_mapparameters.map_size_limit;branch_refused=mk_empty_bounded_mapparameters.map_size_limit;branch_delayed=mk_empty_bounded_mapparameters.map_size_limit;prechecked=Sized_map.empty;unparsable=Operation_hash.Set.empty;in_mempool=Map.empty;applied_rev=[];}letis_empty{(* All fields are intentionaly mentioned, so that we get a warning
when we add a field. This will force to think whether this
function needs to be updated or not. *)parameters=_;refused=_;outdated=_;branch_refused=_;branch_delayed=_;prechecked=_;applied_rev=_;unparsable;in_mempool;}=(* By checking only [in_mempool] here, we rely on the invariant that
[in_mempool] is the union of all other fields (see the MLI for
detailed documentation of this invariant) except unparsable
operations which are not classified yet. *)Map.is_emptyin_mempool&&Operation_hash.Set.is_emptyunparsableletset_of_bounded_mapbounded_map=Map.fold(funoph_acc->Operation_hash.Set.addophacc)bounded_map.mapOperation_hash.Set.emptyletflush(classes:'protocol_datat)~handle_branch_refused=letremove_map_from_in_mempoolmap=classes.in_mempool<-Map.fold(funoph_mempool->Map.removeophmempool)mapclasses.in_mempoolinletremove_list_from_in_mempoollist=classes.in_mempool<-List.fold_left(funmempoolop->Map.removeop.Prevalidation.hashmempool)classes.in_mempoollistinifhandle_branch_refusedthen(remove_map_from_in_mempoolclasses.branch_refused.map;Ringo.Ring.clearclasses.branch_refused.ring;classes.branch_refused.map<-Map.empty);remove_map_from_in_mempoolclasses.branch_delayed.map;Ringo.Ring.clearclasses.branch_delayed.ring;classes.branch_delayed.map<-Map.empty;remove_list_from_in_mempoolclasses.applied_rev;classes.applied_rev<-[];remove_map_from_in_mempool(Sized_map.to_mapclasses.prechecked);classes.unparsable<-Operation_hash.Set.empty;classes.prechecked<-Sized_map.emptyletis_in_mempoolophclasses=Map.findophclasses.in_mempoolletis_known_unparsableophclasses=Operation_hash.Set.memophclasses.unparsable(* Removing an operation is currently used for operations which are
banned (this can only be achieved by the adminstrator of the
node). However, removing an operation which is applied invalidates
the classification of all the operations. Hence, the
classifications of all the operations should be reset. Currently,
this is not enforced by the function and has to be done by the
caller.
Later on, it would be probably better if this function returns a
set of pending operations instead. *)letremoveophclasses=matchMap.findophclasses.in_mempoolwith|None->None|Some(op,classification)->(classes.in_mempool<-Map.removeophclasses.in_mempool;matchclassificationwith|`Refused_->classes.refused.map<-Map.removeophclasses.refused.map|`Outdated_->classes.outdated.map<-Map.removeophclasses.outdated.map|`Branch_refused_->classes.branch_refused.map<-Map.removeophclasses.branch_refused.map|`Branch_delayed_->classes.branch_delayed.map<-Map.removeophclasses.branch_delayed.map|`Prechecked->classes.prechecked<-Sized_map.removeophclasses.prechecked|`Applied->classes.applied_rev<-List.filter(funop->Operation_hash.(op.Prevalidation.hash<>oph))classes.applied_rev);Some(op,classification)lethandle_appliedophopclasses=classes.applied_rev<-op::classes.applied_rev;classes.in_mempool<-Map.addoph(op,`Applied)classes.in_mempoollethandle_precheckedophopclasses=classes.prechecked<-Sized_map.addophopclasses.prechecked;classes.in_mempool<-Map.addoph(op,`Prechecked)classes.in_mempool(* 1. Add the operation to the ring underlying the corresponding
error map class.
2a. If the ring is full, remove the discarded operation from the
map and the [in_mempool] set, and calls the callback with the
discarded operation.
2b. If the operation is [Refused], call the callback with it, as
the operation is discarded. In this case it means the operation
should not be propagated. It is still stored in a bounded map for
the [pending_operations] RPC.
3. Add the operation to the underlying map.
4. Add the operation to the [in_mempool] set. *)lethandle_errorophopclassificationclasses=letbounded_map,tztrace=matchclassificationwith|`Branch_refusedtztrace->(classes.branch_refused,tztrace)|`Branch_delayedtztrace->(classes.branch_delayed,tztrace)|`Refusedtztrace->(classes.refused,tztrace)|`Outdatedtztrace->(classes.outdated,tztrace)inRingo.Ring.add_and_return_erasedbounded_map.ringoph|>Option.iter(fune->bounded_map.map<-Map.removeebounded_map.map;classes.parameters.on_discarded_operatione;classes.in_mempool<-Map.removeeclasses.in_mempool);(matchclassificationwith|`Refused_|`Outdated_->classes.parameters.on_discarded_operationoph|`Branch_delayed_|`Branch_refused_->());bounded_map.map<-Map.addoph(op,tztrace)bounded_map.map;letclassification:classification=(classification:>classification)inclasses.in_mempool<-Map.addoph(op,classification)classes.in_mempoolletadd_unparsableophclasses=classes.unparsable<-Operation_hash.Set.addophclasses.unparsable;classes.parameters.on_discarded_operationophletaddclassificationopclasses=matchclassificationwith|`Applied->handle_appliedop.Prevalidation.hashopclasses|`Prechecked->handle_precheckedop.Prevalidation.hashopclasses|(`Branch_refused_|`Branch_delayed_|`Refused_|`Outdated_)asclassification->handle_errorop.Prevalidation.hashopclassificationclassesletto_map~applied~prechecked~branch_delayed~branch_refused~refused~outdatedclasses:'protocol_dataPrevalidation.operationMap.t=let(+>)accumto_add=letmerge_fun_kaccum_v_optto_add_v_opt=match(accum_v_opt,to_add_v_opt)with|Someaccum_v,None->Someaccum_v|None,Some(to_add_v,_err)->Someto_add_v|Some_accum_v,Some(to_add_v,_err)->(* This case should not happen, because the different classes
should be disjoint. However, if this invariant is broken,
it is not critical, hence we do not raise an error.
Because such part of the code is quite technical and
the invariant is not critical,
we don't advertise the node administrator either (no log). *)Someto_add_v|None,None->NoneinMap.mergemerge_funaccumto_addinMap.union(fun_ophop_->Someop)(ifprecheckedthenSized_map.to_mapclasses.precheckedelseMap.empty)@@(ifappliedthenList.to_seqclasses.applied_rev|>Seq.map(funop->(op.Prevalidation.hash,op))|>Map.of_seqelseMap.empty)+>(ifbranch_delayedthenclasses.branch_delayed.mapelseMap.empty)+>(ifbranch_refusedthenclasses.branch_refused.mapelseMap.empty)+>(ifrefusedthenclasses.refused.mapelseMap.empty)+>ifoutdatedthenclasses.outdated.mapelseMap.emptytype'blockblock_tools={hash:'block->Block_hash.t;operations:'block->Operation.tlistlist;all_operation_hashes:'block->Operation_hash.tlistlist;}type'blockchain_tools={clear_or_cancel:Operation_hash.t->unit;inject_operation:Operation_hash.t->Operation.t->unitLwt.t;new_blocks:from_block:'block->to_block:'block->('block*'blocklist)Lwt.t;read_predecessor_opt:'block->'blockoptionLwt.t;}(* There's detailed documentation in the mli *)lethandle_live_operations~classes~(block_store:'blockblock_tools)~(chain:'blockchain_tools)~(from_branch:'block)~(to_branch:'block)~(is_branch_alive:Block_hash.t->bool)~(parse:Operation_hash.t->Operation.t->'protocol_dataPrevalidation.operationoption)old_mempool=letopenLwt_syntaxinletrecpop_blockancestor(block:'block)mempool=lethash=block_store.hashblockinifBlock_hash.equalhashancestorthenLwt.returnmempoolelseletoperations=block_store.operationsblockinlet*mempool=List.fold_left_s(List.fold_left_s(funmempoolop->letoph=Operation.hashopinlet+()=chain.inject_operationophopinmatchparseophopwith|None->(* There are hidden invariants between the shell and
the economic protocol which should ensure this will
(almost) never happen in practice:
1. Decoding/encoding an operation only depends
on the protocol and not the current context.
2. It is not possible to have a reorganisation
where one branch is using one protocol and another
branch on another protocol.
3. Ok, actually there might be one case using
[user_activated_upgrades] where this could happen,
but this is quite rare.
If this happens, we classifies an operation as
unparsable and it is ok. *)add_unparsableophclasses;mempool|Someparsed_op->Operation_hash.Map.addophparsed_opmempool))mempooloperationsinlet*o=chain.read_predecessor_optblockinmatchowith|None->(* Can this happen? If yes, there's nothing more to pop anyway,
so returning the accumulator. It's not the mempool that
should crash, should this case happen. *)let+()=Event.(emitpredecessor_less_blockancestor)inmempool|Somepredecessor->(* This is a tailcall, which is nice; that is why we annotate
here. But it is not required for the code to be correct.
Given the maximum size of possible reorgs, even if the call
was not tail recursive; we wouldn't reach the runtime's stack
limit. *)(pop_block[@tailcall])ancestorpredecessormempoolinletpush_blockmempoolblock=letoperations=block_store.all_operation_hashesblockinList.iter(List.iterchain.clear_or_cancel)operations;List.fold_left(List.fold_left(funmempoolh->Operation_hash.Map.removehmempool))mempooloperationsinlet*ancestor,path=chain.new_blocks~from_block:from_branch~to_block:to_branchinlet+mempool=pop_block(block_store.hashancestor)from_branchold_mempoolinletnew_mempool=List.fold_leftpush_blockmempoolpathinletnew_mempool,outdated=Map.partition(fun_ophop->is_branch_aliveop.Prevalidation.raw.Operation.shell.branch)new_mempoolinMap.iter(funoph_op->chain.clear_or_canceloph)outdated;new_mempoolletrecycle_operations~from_branch~to_branch~live_blocks~classes~parse~pending~(block_store:'blockblock_tools)~(chain:'blockchain_tools)~handle_branch_refused=letopenLwt_syntaxinlet+pending=handle_live_operations~classes~block_store~chain~from_branch~to_branch~is_branch_alive:(funbranch->Block_hash.Set.membranchlive_blocks)~parse(Map.union(fun_keyv_->Somev)(to_map~applied:true~prechecked:true~branch_delayed:true~branch_refused:handle_branch_refused~refused:false~outdated:falseclasses)pending)in(* Non parsable operations that were previously included in a block
will be removed by the call to [flush]. However, as explained in
[handle_live_operations] it should never happen in practice. *)flushclasses~handle_branch_refused;pendingmoduleInternal_for_tests=struct(** [copy_bounded_map bm] returns a deep copy of [bm] *)letcopy_bounded_map(bm:'protocol_databounded_map):'protocol_databounded_map=letcopy_ring(ring:Operation_hash.tRingo.Ring.t)=letresult=Ringo.Ring.capacityring|>Ringo.Ring.createinList.iter(Ringo.Ring.addresult)(Ringo.Ring.elementsring);resultin{map=bm.map;ring=copy_ringbm.ring}letcopy(t:'protocol_datat):'protocol_datat=(* Code could be shorter by doing a functional update thanks to
the 'with' keyword. We rather list all the fields, so that
the compiler emits a warning when a field is added. *){parameters=t.parameters;refused=copy_bounded_mapt.refused;outdated=copy_bounded_mapt.outdated;branch_refused=copy_bounded_mapt.branch_refused;branch_delayed=copy_bounded_mapt.branch_delayed;applied_rev=t.applied_rev;prechecked=t.prechecked;unparsable=t.unparsable;in_mempool=t.in_mempool;}let[@coverageoff]bounded_map_ppppfbounded_map=bounded_map.map|>Map.bindings|>List.map(fun(key,_value)->key)|>Format.fprintfppf"%a"(Format.pp_print_listOperation_hash.pp)let[@coverageoff]ppppf{parameters;refused;outdated;branch_refused;branch_delayed;applied_rev;prechecked;unparsable;in_mempool;}=letapplied_ppppfapplied=applied|>List.map(funop->op.Prevalidation.hash)|>Format.fprintfppf"%a"(Format.pp_print_listOperation_hash.pp)inletin_mempool_ppppfin_mempool=in_mempool|>Map.bindings|>List.mapfst|>Format.fprintfppf"%a"(Format.pp_print_listOperation_hash.pp)inletprechecked_ppppfprechecked=prechecked|>Sized_map.bindings|>List.mapfst|>Format.fprintfppf"%a"(Format.pp_print_listOperation_hash.pp)inletunparsable_ppppfunparsable=unparsable|>Operation_hash.Set.elements|>Format.fprintfppf"%a"(Format.pp_print_listOperation_hash.pp)inFormat.fprintfppf"Map_size_limit:@.%i@.On discarded operation: \
<function>@.Refused:%a@.Outdated:%a@.Branch refused:@.%a@.Branch \
delayed:@.%a@.Applied:@.%a@.Prechecked:@.%a@.Unparsable:@.%a@.In \
Mempool:@.%a"parameters.map_size_limitbounded_map_pprefusedbounded_map_ppoutdatedbounded_map_ppbranch_refusedbounded_map_ppbranch_delayedapplied_ppapplied_revprechecked_ppprecheckedunparsable_ppunparsablein_mempool_ppin_mempoolletset_of_bounded_map=set_of_bounded_maplet[@coverageoff]pp_t_sizesppt=letshow_bounded_mapnamebounded_map=Format.sprintf"%s map: %d, %s ring: %d"name(Map.cardinalbounded_map.map)name(Ringo.Ring.lengthbounded_map.ring)inletshow_mapname(map:'aSized_map.t)=Format.sprintf"%s map: %d"name(Sized_map.cardinalmap)inFormat.fprintfpp"map_size_limit: %d\n%s\n%s\n%s\n%s\n%sapplied_rev: %d\nin_mempool: %d"t.parameters.map_size_limit(show_bounded_map"refused"t.refused)(show_bounded_map"outdated"t.outdated)(show_bounded_map"branch_refused"t.branch_refused)(show_bounded_map"branch_delayed"t.branch_delayed)(show_map"prechecked"t.prechecked)(List.lengtht.applied_rev)(Map.cardinalt.in_mempool)letto_map=to_mapletflush=flushlethandle_live_operations=handle_live_operationsend