123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120(*****************************************************************************)(* *)(* Open Source License *)(* Copyright (c) 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. *)(* *)(*****************************************************************************)typeprotocol=Nairobi|Oxford|Proto_alpha(* This type mimics [Sc_rollup_inbox_repr.internal_inbox_messages], without
fully deserializing the `Transfer`, and is produced by reading the first bytes
from the input:
- `\000\000` corresponds to a Transfer,
- `\000\001` a start_of_level,
- `\000\002` an end_of_level,
- `\000\003` an info_per_level input,
- `\000\004` a protocol migration input,
- Any other tag will considered as an `Other message`. *)typeinternal_message_kind=|Transfer|Start_of_level|End_of_level|Info_per_level|Protocol_migrationofprotocol(* This type mimics [Sc_rollup_inbox_repr.t] and produced by reading the first
bytes from the input:
- `\000` corresponds to an internal message,
- `\001` an external one, and its content includes the tag.
- Any other tag is considered as an `Other message`. Note that these messages
are not discarded by the PVM, simply not recognized. *)typet=Internalofinternal_message_kind|External|Otherletprotocol_from_rawpayload=ifString.lengthpayload<3thenNoneelseletpayload=String.subpayload2(String.lengthpayload-2)inmatchData_encoding.(Binary.of_string_exnstringpayload)with|payloadwhenString.equalpayloadConstants.proto_alpha_name->Some(Protocol_migrationProto_alpha)|payloadwhenString.equalpayloadConstants.oxford_name->Some(Protocol_migrationOxford)|payloadwhenString.equalpayloadConstants.nairobi_name->Some(Protocol_migrationNairobi)|_->Noneletinternal_from_rawpayload=ifString.lengthpayload<2thenNoneelsematchString.getpayload1with|'\000'->SomeTransfer|'\001'whenString.lengthpayload=2->SomeStart_of_level|'\002'whenString.lengthpayload=2->SomeEnd_of_level|'\003'->SomeInfo_per_level|'\004'->protocol_from_rawpayload|_->Noneletfrom_raw_inputpayload=ifString.lengthpayload<1thenOtherelsematchString.getpayload0with|'\000'->Option.fold~none:Other~some:(funmsg->Internalmsg)(internal_from_rawpayload)|'\001'->External|_->OthermoduleInternal_for_tests=structletproto_to_binary=function|Nairobi->Data_encoding.(Binary.to_string_exnstringConstants.nairobi_name)|Oxford->Data_encoding.(Binary.to_string_exnstringConstants.oxford_name)|Proto_alpha->Data_encoding.(Binary.to_string_exnstringConstants.proto_alpha_name)letto_binary_inputinputmessage=match(input,message)with|InternalTransfer,Somemessage->"\000\000"^message|External,Somemessage->"\001"^message|InternalStart_of_level,None->"\000\001"|InternalEnd_of_level,None->"\000\002"|InternalInfo_per_level,Someinfo->"\000\003"^info|Internal(Protocol_migrationproto),None->"\000\004"^proto_to_binaryproto|Other,_->Stdlib.failwith"`Other` messages are impossible cases from the PVM perspective."|Internal(Start_of_level|End_of_level),Some_->Stdlib.failwith"`Start_of_level` and `End_of_level` do not expect a payload"|InternalTransfer,None->Stdlib.failwith"`Transfer` expects a payload"|InternalInfo_per_level,None->Stdlib.failwith"`Info_per_level` expects a payload"|Internal(Protocol_migration_),Some_->Stdlib.failwith"`Protocol_migration` does not expect a payload"|External,None->Stdlib.failwith"`External` expects a payload"end