283 lines
12 KiB
OCaml
283 lines
12 KiB
OCaml
(*****************************************************************************)
|
|
(* *)
|
|
(* Open Source License *)
|
|
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
|
|
(* Copyright (c) 2018 Nomadic Labs. <nomadic@tezcore.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. *)
|
|
(* *)
|
|
(*****************************************************************************)
|
|
|
|
open Block_validator_errors
|
|
|
|
type result = {
|
|
validation_result: Tezos_protocol_environment_shell.validation_result ;
|
|
block_metadata: MBytes.t ;
|
|
ops_metadata: MBytes.t list list ;
|
|
context_hash: Context_hash.t ;
|
|
}
|
|
|
|
let may_patch_protocol
|
|
~level
|
|
(validation_result : Tezos_protocol_environment_shell.validation_result) =
|
|
match Block_header.get_forced_protocol_upgrade ~level with
|
|
| None ->
|
|
return validation_result
|
|
| Some hash ->
|
|
Context.set_protocol validation_result.context hash >>= fun context ->
|
|
return { validation_result with context }
|
|
|
|
module Make(Proto : Registered_protocol.T) = struct
|
|
|
|
let check_block_header
|
|
~(predecessor_block_header : Block_header.t)
|
|
hash (block_header: Block_header.t) =
|
|
let validation_passes = List.length Proto.validation_passes in
|
|
fail_unless
|
|
(Int32.succ predecessor_block_header.shell.level = block_header.shell.level)
|
|
(invalid_block hash @@
|
|
Invalid_level { expected = Int32.succ predecessor_block_header.shell.level ;
|
|
found = block_header.shell.level }) >>=? fun () ->
|
|
fail_unless
|
|
Time.(predecessor_block_header.shell.timestamp < block_header.shell.timestamp)
|
|
(invalid_block hash Non_increasing_timestamp) >>=? fun () ->
|
|
fail_unless
|
|
Fitness.(predecessor_block_header.shell.fitness < block_header.shell.fitness)
|
|
(invalid_block hash Non_increasing_fitness) >>=? fun () ->
|
|
fail_unless
|
|
(block_header.shell.validation_passes = validation_passes)
|
|
(invalid_block hash
|
|
(Unexpected_number_of_validation_passes block_header.shell.validation_passes)
|
|
) >>=? fun () ->
|
|
return_unit
|
|
|
|
let parse_block_header block_hash (block_header : Block_header.t) =
|
|
match
|
|
Data_encoding.Binary.of_bytes
|
|
Proto.block_header_data_encoding
|
|
block_header.protocol_data with
|
|
| None ->
|
|
fail (invalid_block block_hash Cannot_parse_block_header)
|
|
| Some protocol_data ->
|
|
return ({ shell = block_header.shell ; protocol_data } : Proto.block_header)
|
|
|
|
let check_operation_quota block_hash operations =
|
|
let invalid_block = invalid_block block_hash in
|
|
iteri2_p
|
|
begin fun i ops quota ->
|
|
fail_unless
|
|
(Option.unopt_map ~default:true
|
|
~f:(fun max -> List.length ops <= max)
|
|
quota.Tezos_protocol_environment_shell.max_op)
|
|
(let max = Option.unopt ~default:~-1 quota.max_op in
|
|
invalid_block
|
|
(Too_many_operations
|
|
{ pass = i + 1 ; found = List.length ops ; max })) >>=? fun () ->
|
|
iter_p
|
|
begin fun op ->
|
|
let size = Data_encoding.Binary.length Operation.encoding op in
|
|
fail_unless
|
|
(size <= Proto.max_operation_data_length)
|
|
(invalid_block
|
|
(Oversized_operation
|
|
{ operation = Operation.hash op ;
|
|
size ; max = Proto.max_operation_data_length }))
|
|
end
|
|
ops >>=? fun () ->
|
|
return_unit
|
|
end
|
|
operations Proto.validation_passes
|
|
|
|
let parse_operations block_hash operations =
|
|
let invalid_block = invalid_block block_hash in
|
|
mapi_s
|
|
begin fun pass ->
|
|
map_s begin fun op ->
|
|
let op_hash = Operation.hash op in
|
|
match
|
|
Data_encoding.Binary.of_bytes
|
|
Proto.operation_data_encoding
|
|
op.Operation.proto with
|
|
| None ->
|
|
fail (invalid_block (Cannot_parse_operation op_hash))
|
|
| Some protocol_data ->
|
|
let op = { Proto.shell = op.shell ; protocol_data } in
|
|
let allowed_pass = Proto.acceptable_passes op in
|
|
fail_unless (List.mem pass allowed_pass)
|
|
(invalid_block
|
|
(Unallowed_pass { operation = op_hash ;
|
|
pass ; allowed_pass } )) >>=? fun () ->
|
|
return op
|
|
end
|
|
end
|
|
operations
|
|
|
|
let apply
|
|
chain_id
|
|
~max_operations_ttl
|
|
~(predecessor_block_header : Block_header.t)
|
|
~predecessor_context
|
|
~(block_header : Block_header.t)
|
|
operations =
|
|
let block_hash = Block_header.hash block_header in
|
|
let invalid_block = invalid_block block_hash in
|
|
let pred_hash = Block_header.hash predecessor_block_header in
|
|
check_block_header
|
|
~predecessor_block_header
|
|
block_hash block_header >>=? fun () ->
|
|
parse_block_header block_hash block_header >>=? fun block_header ->
|
|
check_operation_quota block_hash operations >>=? fun () ->
|
|
Context.reset_test_chain
|
|
predecessor_context pred_hash block_header.shell.timestamp >>= fun context ->
|
|
parse_operations block_hash operations >>=? fun operations ->
|
|
(* TODO wrap 'proto_error' into 'block_error' *)
|
|
Proto.begin_application
|
|
~chain_id
|
|
~predecessor_context:context
|
|
~predecessor_timestamp:predecessor_block_header.shell.timestamp
|
|
~predecessor_fitness:predecessor_block_header.shell.fitness
|
|
block_header >>=? fun state ->
|
|
fold_left_s
|
|
(fun (state, acc) ops ->
|
|
fold_left_s
|
|
(fun (state, acc) op ->
|
|
Proto.apply_operation state op >>=? fun (state, op_metadata) ->
|
|
return (state, op_metadata :: acc))
|
|
(state, []) ops >>=? fun (state, ops_metadata) ->
|
|
return (state, List.rev ops_metadata :: acc))
|
|
(state, []) operations >>=? fun (state, ops_metadata) ->
|
|
let ops_metadata = List.rev ops_metadata in
|
|
Proto.finalize_block state >>=? fun (validation_result, block_data) ->
|
|
may_patch_protocol
|
|
~level:block_header.shell.level validation_result >>=? fun validation_result ->
|
|
Context.get_protocol validation_result.context >>= fun new_protocol ->
|
|
let expected_proto_level =
|
|
if Protocol_hash.equal new_protocol Proto.hash then
|
|
predecessor_block_header.shell.proto_level
|
|
else
|
|
(predecessor_block_header.shell.proto_level + 1) mod 256 in
|
|
fail_when (block_header.shell.proto_level <> expected_proto_level)
|
|
(invalid_block
|
|
(Invalid_proto_level {
|
|
found = block_header.shell.proto_level ;
|
|
expected = expected_proto_level ;
|
|
})) >>=? fun () ->
|
|
fail_when
|
|
Fitness.(validation_result.fitness <> block_header.shell.fitness)
|
|
(invalid_block
|
|
(Invalid_fitness {
|
|
expected = block_header.shell.fitness ;
|
|
found = validation_result.fitness ;
|
|
})) >>=? fun () ->
|
|
begin
|
|
if Protocol_hash.equal new_protocol Proto.hash then
|
|
return validation_result
|
|
else
|
|
match Registered_protocol.get new_protocol with
|
|
| None ->
|
|
fail (Unavailable_protocol { block = block_hash ;
|
|
protocol = new_protocol })
|
|
| Some (module NewProto) ->
|
|
NewProto.init validation_result.context block_header.shell
|
|
end >>=? fun validation_result ->
|
|
let max_operations_ttl =
|
|
max 0
|
|
(min
|
|
((max_operations_ttl)+1)
|
|
validation_result.max_operations_ttl) in
|
|
let validation_result =
|
|
{ validation_result with max_operations_ttl } in
|
|
let block_metadata =
|
|
Data_encoding.Binary.to_bytes_exn
|
|
Proto.block_header_metadata_encoding block_data in
|
|
let ops_metadata =
|
|
List.map
|
|
(List.map
|
|
(Data_encoding.Binary.to_bytes_exn
|
|
Proto.operation_receipt_encoding))
|
|
ops_metadata in
|
|
Context.commit
|
|
~time:block_header.shell.timestamp
|
|
?message:validation_result.message
|
|
validation_result.context >>= fun context_hash ->
|
|
return ({ validation_result ; block_metadata ;
|
|
ops_metadata ; context_hash })
|
|
|
|
end
|
|
|
|
let assert_no_duplicate_operations block_hash live_operations operations =
|
|
fold_left_s
|
|
begin fold_left_s
|
|
begin fun live_operations op ->
|
|
let oph = Operation.hash op in
|
|
fail_when (Operation_hash.Set.mem oph live_operations)
|
|
(invalid_block block_hash @@ Replayed_operation oph) >>=? fun () ->
|
|
return (Operation_hash.Set.add oph live_operations)
|
|
end
|
|
end
|
|
live_operations operations >>=? fun _ ->
|
|
return_unit
|
|
|
|
let assert_operation_liveness block_hash live_blocks operations =
|
|
iter_s
|
|
begin iter_s
|
|
begin fun op ->
|
|
fail_unless
|
|
(Block_hash.Set.mem op.Operation.shell.branch live_blocks)
|
|
(invalid_block block_hash @@
|
|
Outdated_operation { operation = Operation.hash op ;
|
|
originating_block = op.shell.branch })
|
|
end
|
|
end
|
|
operations
|
|
|
|
let check_liveness ~live_blocks ~live_operations block_hash operations =
|
|
assert_no_duplicate_operations
|
|
block_hash live_operations operations >>=? fun () ->
|
|
assert_operation_liveness block_hash live_blocks operations >>=? fun () ->
|
|
return_unit
|
|
|
|
let apply
|
|
chain_id
|
|
~max_operations_ttl
|
|
~(predecessor_block_header : Block_header.t)
|
|
~predecessor_context
|
|
~(block_header : Block_header.t)
|
|
operations =
|
|
let block_hash = Block_header.hash block_header in
|
|
Context.get_protocol predecessor_context >>= fun pred_protocol_hash ->
|
|
begin
|
|
match Registered_protocol.get pred_protocol_hash with
|
|
| None ->
|
|
fail (Unavailable_protocol { block = block_hash ;
|
|
protocol = pred_protocol_hash })
|
|
| Some p -> return p
|
|
end >>=? fun (module Proto) ->
|
|
let module Block_validation = Make(Proto) in
|
|
Block_validation.apply
|
|
chain_id
|
|
~max_operations_ttl
|
|
~predecessor_block_header
|
|
~predecessor_context
|
|
~block_header
|
|
operations >>= function
|
|
| Error (Exn (Unix.Unix_error (errno, fn, msg)) :: _) ->
|
|
fail (System_error { errno ; fn ; msg })
|
|
| (Ok _ | Error _) as res -> Lwt.return res
|