(*****************************************************************************) (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) (* *) (* 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. *) (* *) (*****************************************************************************) (* Tezos Protocol Implementation - Protocol Signature Instance *) type block_header_data = Alpha_context.Block_header.protocol_data type block_header = Alpha_context.Block_header.t = { shell : Block_header.shell_header; protocol_data : block_header_data; } let block_header_data_encoding = Alpha_context.Block_header.protocol_data_encoding type block_header_metadata = Apply_results.block_metadata let block_header_metadata_encoding = Apply_results.block_metadata_encoding type operation_data = Alpha_context.packed_protocol_data = | Operation_data : 'kind Alpha_context.Operation.protocol_data -> operation_data let operation_data_encoding = Alpha_context.Operation.protocol_data_encoding type operation_receipt = Apply_results.packed_operation_metadata = | Operation_metadata : 'kind Apply_results.operation_metadata -> operation_receipt | No_operation_metadata : operation_receipt let operation_receipt_encoding = Apply_results.operation_metadata_encoding let operation_data_and_receipt_encoding = Apply_results.operation_data_and_metadata_encoding type operation = Alpha_context.packed_operation = { shell : Operation.shell_header; protocol_data : operation_data; } let acceptable_passes = Alpha_context.Operation.acceptable_passes let max_block_length = Alpha_context.Block_header.max_header_length let max_operation_data_length = Alpha_context.Constants.max_operation_data_length let validation_passes = let max_anonymous_operations = Alpha_context.Constants.max_revelations_per_block + (* allow 100 wallet activations or denunciations per block *) 100 in Updater. [ {max_size = 32 * 1024; max_op = Some 32}; (* 32 endorsements *) {max_size = 32 * 1024; max_op = None}; (* 32k of voting operations *) { max_size = max_anonymous_operations * 1024; max_op = Some max_anonymous_operations; }; {max_size = 512 * 1024; max_op = None} ] (* 512kB *) let rpc_services = Alpha_services.register () ; Services_registration.get_rpc_services () type validation_mode = | Application of { block_header : Alpha_context.Block_header.t; baker : Alpha_context.public_key_hash; block_delay : Alpha_context.Period.t; } | Partial_application of { block_header : Alpha_context.Block_header.t; baker : Alpha_context.public_key_hash; block_delay : Alpha_context.Period.t; } | Partial_construction of {predecessor : Block_hash.t} | Full_construction of { predecessor : Block_hash.t; protocol_data : Alpha_context.Block_header.contents; baker : Alpha_context.public_key_hash; block_delay : Alpha_context.Period.t; } type validation_state = { mode : validation_mode; chain_id : Chain_id.t; ctxt : Alpha_context.t; op_count : int; } let current_context {ctxt; _} = return (Alpha_context.finalize ctxt).context let begin_partial_application ~chain_id ~ancestor_context:ctxt ~predecessor_timestamp ~predecessor_fitness (block_header : Alpha_context.Block_header.t) = let level = block_header.shell.level in let fitness = predecessor_fitness in let timestamp = block_header.shell.timestamp in Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt >>=? fun ctxt -> Apply.begin_application ctxt chain_id block_header predecessor_timestamp >>=? fun (ctxt, baker, block_delay) -> let mode = Partial_application {block_header; baker = Signature.Public_key.hash baker; block_delay} in return {mode; chain_id; ctxt; op_count = 0} let begin_application ~chain_id ~predecessor_context:ctxt ~predecessor_timestamp ~predecessor_fitness (block_header : Alpha_context.Block_header.t) = let level = block_header.shell.level in let fitness = predecessor_fitness in let timestamp = block_header.shell.timestamp in Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt >>=? fun ctxt -> Apply.begin_application ctxt chain_id block_header predecessor_timestamp >>=? fun (ctxt, baker, block_delay) -> let mode = Application {block_header; baker = Signature.Public_key.hash baker; block_delay} in return {mode; chain_id; ctxt; op_count = 0} let begin_construction ~chain_id ~predecessor_context:ctxt ~predecessor_timestamp ~predecessor_level:pred_level ~predecessor_fitness:pred_fitness ~predecessor ~timestamp ?(protocol_data : block_header_data option) () = let level = Int32.succ pred_level in let fitness = pred_fitness in Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt >>=? fun ctxt -> ( match protocol_data with | None -> Apply.begin_partial_construction ctxt >>=? fun ctxt -> let mode = Partial_construction {predecessor} in return (mode, ctxt) | Some proto_header -> Apply.begin_full_construction ctxt predecessor_timestamp proto_header.contents >>=? fun (ctxt, protocol_data, baker, block_delay) -> let mode = let baker = Signature.Public_key.hash baker in Full_construction {predecessor; baker; protocol_data; block_delay} in return (mode, ctxt) ) >>=? fun (mode, ctxt) -> return {mode; chain_id; ctxt; op_count = 0} let apply_operation ({mode; chain_id; ctxt; op_count; _} as data) (operation : Alpha_context.packed_operation) = match mode with | Partial_application _ when not (List.exists (Compare.Int.equal 0) (Alpha_context.Operation.acceptable_passes operation)) -> (* Multipass validation only considers operations in pass 0. *) let op_count = op_count + 1 in return ({data with ctxt; op_count}, No_operation_metadata) | _ -> let {shell; protocol_data = Operation_data protocol_data} = operation in let operation : _ Alpha_context.operation = {shell; protocol_data} in let (predecessor, baker) = match mode with | Partial_application {block_header = {shell = {predecessor; _}; _}; baker} | Application {block_header = {shell = {predecessor; _}; _}; baker} | Full_construction {predecessor; baker; _} -> (predecessor, baker) | Partial_construction {predecessor} -> (predecessor, Signature.Public_key_hash.zero) in Apply.apply_operation ctxt chain_id Optimized predecessor baker (Alpha_context.Operation.hash operation) operation >>=? fun (ctxt, result) -> let op_count = op_count + 1 in return ({data with ctxt; op_count}, Operation_metadata result) let finalize_block {mode; ctxt; op_count} = match mode with | Partial_construction _ -> let level = Alpha_context.Level.current ctxt in Alpha_context.Vote.get_current_period_kind ctxt >>=? fun voting_period_kind -> let baker = Signature.Public_key_hash.zero in Signature.Public_key_hash.Map.fold (fun delegate deposit ctxt -> ctxt >>=? fun ctxt -> Alpha_context.Delegate.freeze_deposit ctxt delegate deposit) (Alpha_context.get_deposits ctxt) (return ctxt) >>=? fun ctxt -> let ctxt = Alpha_context.finalize ctxt in return ( ctxt, Apply_results. { baker; level; voting_period_kind; nonce_hash = None; consumed_gas = Z.zero; deactivated = []; balance_updates = []; } ) | Partial_application {block_header; baker; block_delay} -> let level = Alpha_context.Level.current ctxt in let included_endorsements = Alpha_context.included_endorsements ctxt in Apply.check_minimum_endorsements ctxt block_header.protocol_data.contents block_delay included_endorsements >>=? fun () -> Alpha_context.Vote.get_current_period_kind ctxt >>=? fun voting_period_kind -> let ctxt = Alpha_context.finalize ctxt in return ( ctxt, Apply_results. { baker; level; voting_period_kind; nonce_hash = None; consumed_gas = Z.zero; deactivated = []; balance_updates = []; } ) | Application { baker; block_delay; block_header = {protocol_data = {contents = protocol_data; _}; _} } | Full_construction {protocol_data; baker; block_delay; _} -> Apply.finalize_application ctxt protocol_data baker ~block_delay >>=? fun (ctxt, receipt) -> let level = Alpha_context.Level.current ctxt in let priority = protocol_data.priority in let raw_level = Alpha_context.Raw_level.to_int32 level.level in let fitness = Alpha_context.Fitness.current ctxt in let commit_message = Format.asprintf "lvl %ld, fit 1:%Ld, prio %d, %d ops" raw_level fitness priority op_count in let ctxt = Alpha_context.finalize ~commit_message ctxt in return (ctxt, receipt) 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 (Endorsement _), Single (Endorsement _)) -> 0 | (_, Single (Endorsement _)) -> 1 | (Single (Endorsement _), _) -> -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)) -> Z.compare op1.counter op2.counter | (Cons (Manager_operation op1, _), Single (Manager_operation op2)) -> Z.compare op1.counter op2.counter | (Single (Manager_operation op1), Cons (Manager_operation op2, _)) -> Z.compare op1.counter op2.counter | (Cons (Manager_operation op1, _), Cons (Manager_operation op2, _)) -> Z.compare op1.counter op2.counter let init ctxt block_header = let level = block_header.Block_header.level in let fitness = block_header.fitness in let timestamp = block_header.timestamp in let typecheck (ctxt : Alpha_context.context) (script : Alpha_context.Script.t) = Script_ir_translator.parse_script ctxt ~legacy:false script >>=? fun (Ex_script parsed_script, ctxt) -> Script_ir_translator.extract_big_map_diff ctxt Optimized parsed_script.storage_type parsed_script.storage ~to_duplicate:Script_ir_translator.no_big_map_id ~to_update:Script_ir_translator.no_big_map_id ~temporary:false >>=? fun (storage, big_map_diff, ctxt) -> Script_ir_translator.unparse_data ctxt Optimized parsed_script.storage_type storage >>=? fun (storage, ctxt) -> let storage = Alpha_context.Script.lazy_expr (Micheline.strip_locations storage) in return (({script with storage}, big_map_diff), ctxt) in Alpha_context.prepare_first_block ~typecheck ~level ~timestamp ~fitness ctxt >>=? fun ctxt -> return (Alpha_context.finalize ctxt) (* Vanity nonce: 0050006865723388 *)