(*****************************************************************************) (* *) (* 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 ; } | Partial_application of { block_header : Alpha_context.Block_header.t ; baker : Alpha_context.public_key_hash ; } | 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 ; } 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 ~timestamp ~fitness ctxt >>=? fun ctxt -> Apply.begin_application ctxt chain_id block_header predecessor_timestamp >>=? fun (ctxt, baker) -> let mode = Partial_application { block_header ; baker = Signature.Public_key.hash baker } 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 ~timestamp ~fitness ctxt >>=? fun ctxt -> Apply.begin_application ctxt chain_id block_header predecessor_timestamp >>=? fun (ctxt, baker) -> let mode = Application { block_header ; baker = Signature.Public_key.hash baker } in return { mode ; chain_id ; ctxt ; op_count = 0 } let begin_construction ~chain_id ~predecessor_context:ctxt ~predecessor_timestamp:pred_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 ~timestamp ~level ~fitness ctxt >>=? fun ctxt -> begin 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 pred_timestamp proto_header.contents >>=? fun (ctxt, protocol_data, baker) -> let mode = let baker = Signature.Public_key.hash baker in Full_construction { predecessor ; baker ; protocol_data } in return (mode, ctxt) end >>=? 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 let partial = match mode with | Partial_construction _ -> true | Application _ | Full_construction _ | Partial_application _ -> false in Apply.apply_operation ~partial 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 { baker ; _ } -> let level = Alpha_context. Level.current ctxt in 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_header = { protocol_data = { contents = protocol_data ; _ } ; _ } } | Full_construction { protocol_data ; baker ; _ } -> Apply.finalize_application ctxt protocol_data baker >>=? 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 %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 script >>=? fun (ex_script, ctxt) -> Script_ir_translator.big_map_initialization ctxt Optimized ex_script >>=? fun (big_map_diff, ctxt) -> return ((script, big_map_diff), ctxt) in Alpha_context.prepare_first_block ~typecheck ~level ~timestamp ~fitness ctxt >>=? fun ctxt -> return (Alpha_context.finalize ctxt)