Shell/validator: allow standalone block validation

Co-authored with `Grégoire Henry <gregoire.henry@tezos.com>`

.gitlab-ci.yml

@@ -197,6 +197,10 @@ test:linkcheck:
     - make doc-linkcheck
   allow_failure: true
 
+test:validation:
+  <<: *test_definition
+  script:
+    - dune build @src/lib_validation/runtest
 
 ############################################################
 ## Stage: building opam packages (only master and *opam*) ##
@@ -458,21 +462,21 @@ opam:47:tezos-embedded-protocol-alpha:
   variables:
     package: tezos-embedded-protocol-alpha
 
-opam:48:tezos-embedded-protocol-demo:
+opam:48:tezos-shell:
+  <<: *opam_definition
+  variables:
+    package: tezos-shell
+
+opam:49:tezos-embedded-protocol-demo:
   <<: *opam_definition
   variables:
     package: tezos-embedded-protocol-demo
 
-opam:49:tezos-embedded-protocol-genesis:
+opam:50:tezos-embedded-protocol-genesis:
   <<: *opam_definition
   variables:
     package: tezos-embedded-protocol-genesis
 
-opam:50:tezos-shell:
-  <<: *opam_definition
-  variables:
-    package: tezos-shell
-
 opam:51:tezos-endorser-alpha-commands:
   <<: *opam_definition
   variables:
@@ -488,47 +492,52 @@ opam:53:ocplib-ezresto-directory:
   variables:
     package: ocplib-ezresto-directory
 
-opam:54:tezos-accuser-alpha:
+opam:54:tezos-validation:
+  <<: *opam_definition
+  variables:
+    package: tezos-validation
+
+opam:55:tezos-accuser-alpha:
   <<: *opam_definition
   variables:
     package: tezos-accuser-alpha
 
-opam:55:tezos-endorser-alpha:
+opam:56:tezos-endorser-alpha:
   <<: *opam_definition
   variables:
     package: tezos-endorser-alpha
 
-opam:56:tezos-accuser-alpha-commands:
+opam:57:tezos-accuser-alpha-commands:
   <<: *opam_definition
   variables:
     package: tezos-accuser-alpha-commands
 
-opam:57:tezos-baker-alpha:
+opam:58:tezos-baker-alpha:
   <<: *opam_definition
   variables:
     package: tezos-baker-alpha
 
-opam:58:tezos-protocol-demo:
+opam:59:tezos-protocol-demo:
   <<: *opam_definition
   variables:
     package: tezos-protocol-demo
 
-opam:59:tezos-signer:
+opam:60:tezos-signer:
   <<: *opam_definition
   variables:
     package: tezos-signer
 
-opam:60:tezos-node:
+opam:61:tezos-node:
   <<: *opam_definition
   variables:
     package: tezos-node
 
-opam:61:ocplib-json-typed-browser:
+opam:62:ocplib-json-typed-browser:
   <<: *opam_definition
   variables:
     package: ocplib-json-typed-browser
 
-opam:62:tezos-baker-alpha-commands:
+opam:63:tezos-baker-alpha-commands:
   <<: *opam_definition
   variables:
     package: tezos-baker-alpha-commands

src/lib_shell/block_validator.ml

@@ -25,13 +25,15 @@
 
 open Block_validator_worker_state
 open Block_validator_errors
-let invalid_block block error = Invalid_block { block ; error }
 
 type limits = {
   protocol_timeout: float ;
   worker_limits : Worker_types.limits ;
 }
 
+type validator_kind = Block_validator_process.validator_kind =
+  | Internal of Context.index
+
 module Name = struct
   type t = unit
   let encoding = Data_encoding.empty
@@ -43,10 +45,10 @@ module Types = struct
   include Worker_state
   type state = {
     protocol_validator: Protocol_validator.t ;
-    validation_process: Validator_process.t ;
+    validation_process: Block_validator_process.t ;
     limits : limits ;
   }
-  type parameters = limits * Distributed_db.t * Validator_process.t
+  type parameters = limits * Distributed_db.t * Block_validator_process.validator_kind
   let view _state _parameters = ()
 end
 
@@ -77,117 +79,6 @@ type error += Closed = Worker.Closed
 let debug w =
   Format.kasprintf (fun msg -> Worker.record_event w (Debug msg))
 
-let check_header
-    (pred: State.Block.t) validation_passes hash (header: Block_header.t) =
-  let pred_header = State.Block.header pred in
-  fail_unless
-    (Int32.succ pred_header.shell.level = header.shell.level)
-    (invalid_block hash @@
-     Invalid_level { expected = Int32.succ pred_header.shell.level ;
-                     found = header.shell.level }) >>=? fun () ->
-  fail_unless
-    Time.(pred_header.shell.timestamp < header.shell.timestamp)
-    (invalid_block hash Non_increasing_timestamp) >>=? fun () ->
-  fail_unless
-    Fitness.(pred_header.shell.fitness < header.shell.fitness)
-    (invalid_block hash Non_increasing_fitness) >>=? fun () ->
-  fail_unless
-    (header.shell.validation_passes = validation_passes)
-    (invalid_block hash
-       (Unexpected_number_of_validation_passes header.shell.validation_passes)
-    ) >>=? fun () ->
-  return_unit
-
-let assert_no_duplicate_operations block live_operations operation_hashes =
-  fold_left_s (fold_left_s (fun live_operations oph ->
-      fail_when (Operation_hash.Set.mem oph live_operations)
-        (invalid_block block @@ Replayed_operation oph) >>=? fun () ->
-      return (Operation_hash.Set.add oph live_operations)))
-    live_operations operation_hashes >>=? fun _ ->
-  return_unit
-
-let assert_operation_liveness block live_blocks operations =
-  iter_s (iter_s (fun op ->
-      fail_unless
-        (Block_hash.Set.mem op.Operation.shell.branch live_blocks)
-        (invalid_block block @@
-         Outdated_operation { operation = Operation.hash op ;
-                              originating_block = op.shell.branch })))
-    operations
-
-let check_liveness chain_state pred hash operations_hashes operations =
-  begin
-    Chain.data chain_state >>= fun chain_data ->
-    if State.Block.equal chain_data.current_head pred then
-      Lwt.return (chain_data.live_blocks, chain_data.live_operations)
-    else
-      Chain_traversal.live_blocks
-        pred (State.Block.max_operations_ttl pred)
-  end >>= fun (live_blocks, live_operations) ->
-  assert_no_duplicate_operations
-    hash live_operations operations_hashes >>=? fun () ->
-  assert_operation_liveness hash live_blocks operations >>=? fun () ->
-  return_unit
-
-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 }
-
-let apply_block
-    chain_state
-    validation_process
-    pred (module Proto : Registered_protocol.T)
-    hash (header: Block_header.t)
-    operations =
-  check_header pred (List.length Proto.validation_passes) hash header >>=? fun () ->
-  iteri2_p
-    (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 hash @@
-          Too_many_operations
-            { pass = i + 1 ; found = List.length ops ; max }) >>=? fun () ->
-       iter_p (fun op ->
-           let size = Data_encoding.Binary.length Operation.encoding op in
-           fail_unless
-             (size <= Proto.max_operation_data_length)
-             (invalid_block hash @@
-              Oversized_operation
-                { operation = Operation.hash op ;
-                  size ; max = Proto.max_operation_data_length })) ops >>=? fun () ->
-       return_unit)
-    operations Proto.validation_passes >>=? fun () ->
-  let operation_hashes = List.map (List.map Operation.hash) operations in
-  check_liveness chain_state pred hash operation_hashes operations >>=? fun () ->
-  begin
-    match
-      Data_encoding.Binary.of_bytes
-        Proto.block_header_data_encoding
-        header.protocol_data with
-    | None ->
-        fail (invalid_block hash Cannot_parse_block_header)
-    | Some protocol_data ->
-        return ({ shell = header.shell ; protocol_data } : Proto.block_header)
-  end >>=? fun _header ->
-  Validator_process.apply_block
-    validation_process header operations chain_state
-  >>=? fun { validation_result ; block_data ; ops_metadata ; context_hash } ->
-  let validation_store =
-    ({ context_hash ;
-       message = validation_result.message ;
-       max_operations_ttl =  validation_result.max_operations_ttl ;
-       last_allowed_fork_level = validation_result.last_allowed_fork_level} :
-       State.Block.validation_store) in
-  return (validation_store, block_data, ops_metadata)
-
 let check_chain_liveness chain_db hash (header: Block_header.t) =
   let chain_state = Distributed_db.chain_state chain_db in
   match State.Chain.expiration chain_state with
@@ -234,18 +125,23 @@ let on_request
               debug w "validating block %a" Block_hash.pp_short hash ;
               State.Block.read
                 chain_state header.shell.predecessor >>=? fun pred ->
-              get_proto pred hash >>=? fun proto ->
               (* TODO also protect with [Worker.canceler w]. *)
               protect ?canceler begin fun () ->
-                apply_block
+                Block_validator_process.apply_block
-                  (Distributed_db.chain_state chain_db)
                   bv.validation_process
-                  pred proto hash
+                  ~predecessor:pred
-                  header operations >>=? fun (result, header_data, operations_data) ->
+                  header operations >>=? fun { validation_result ; block_metadata ;
+                                               ops_metadata ; context_hash } ->
+                let validation_store =
+                  ({ context_hash ;
+                     message = validation_result.message ;
+                     max_operations_ttl =  validation_result.max_operations_ttl ;
+                     last_allowed_fork_level = validation_result.last_allowed_fork_level} :
+                     State.Block.validation_store) in
                 Distributed_db.commit_block
                   chain_db hash
-                  header header_data operations operations_data
+                  header block_metadata operations ops_metadata
-                  result >>=? function
+                  validation_store >>=? function
                 | None -> assert false (* should not happen *)
                 | Some block -> return block
               end
@@ -270,8 +166,9 @@ let on_request
                 assert commited ;
                 return (Error errors)
 
-let on_launch _ _ (limits, db, validation_process) =
+let on_launch _ _ (limits, db, validation_kind) =
   let protocol_validator = Protocol_validator.create db in
+  Block_validator_process.init validation_kind >>= fun validation_process ->
   Lwt.return { Types.protocol_validator ; validation_process ; limits }
 
 let on_error w r st errs =
@@ -295,7 +192,7 @@ let on_completion
 
 let on_close w =
   let bv = Worker.state w in
-  Validator_process.close bv.validation_process
+  Block_validator_process.close bv.validation_process
 
 let table = Worker.create_table Queue
 

src/lib_shell/block_validator.mli

@@ -30,11 +30,13 @@ type limits = {
   worker_limits : Worker_types.limits ;
 }
 
+type validator_kind =
+  | Internal of Context.index
+
 type error += Closed of unit
 
 val create:
-  limits ->  Distributed_db.t ->
+  limits ->  Distributed_db.t -> validator_kind ->
-  Validator_process.t ->
   t Lwt.t
 
 val validate:
@@ -60,8 +62,3 @@ val status: t -> Worker_types.worker_status
 val pending_requests : t -> (Time.t * Block_validator_worker_state.Request.view) list
 val current_request : t -> (Time.t * Time.t * Block_validator_worker_state.Request.view) option
 val last_events : t -> (Lwt_log_core.level * Block_validator_worker_state.Event.t list) list
-
-val may_patch_protocol:
-  level:Int32.t ->
-  Tezos_protocol_environment_shell.validation_result ->
-  Tezos_protocol_environment_shell.validation_result tzresult Lwt.t

src/lib_shell/block_validator_process.ml

@@ -0,0 +1,106 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+let get_context index hash =
+  Context.checkout index hash >>= function
+  | None -> fail (Block_validator_errors.Failed_to_checkout_context hash)
+  | Some ctx -> return ctx
+
+(** The standard block validation method *)
+module Seq_validator = struct
+
+  include Logging.Make (struct let name = "validation_process.sequential" end)
+
+  type validation_context = {
+    context_index : Context.index ;
+  }
+
+  type t = validation_context
+
+  let init context_index =
+    lwt_log_notice "Intialized" >>= fun () ->
+    Lwt.return { context_index }
+
+  let close _ =
+    lwt_log_notice "Shutting down ..." >>= fun () ->
+    Lwt.return ()
+
+  let apply_block
+      validator_process
+      chain_id
+      ~max_operations_ttl
+      ~(predecessor_block_header : Block_header.t)
+      ~block_header
+      operations =
+    get_context validator_process.context_index
+      predecessor_block_header.shell.context >>=? fun predecessor_context ->
+    Block_validation.apply
+      chain_id
+      ~max_operations_ttl
+      ~predecessor_block_header
+      ~predecessor_context
+      ~block_header
+      operations
+
+end
+
+type validator_kind =
+  | Internal of Context.index
+
+type t =
+  | Sequential of Seq_validator.t
+
+let init = function
+  | Internal index ->
+      Seq_validator.init index >>= fun v ->
+      Lwt.return (Sequential v)
+
+let close = function
+  | Sequential vp -> Seq_validator.close vp
+
+let apply_block bvp ~predecessor block_header operations =
+  let chain_state = State.Block.chain_state predecessor in
+  let chain_id = State.Block.chain_id predecessor in
+  let predecessor_block_header = State.Block.header predecessor in
+  let max_operations_ttl = State.Block.max_operations_ttl predecessor in
+  let block_hash = Block_header.hash block_header in
+  begin
+    Chain.data chain_state >>= fun chain_data ->
+    if State.Block.equal chain_data.current_head predecessor then
+      Lwt.return (chain_data.live_blocks, chain_data.live_operations)
+    else
+      Chain_traversal.live_blocks
+        predecessor (State.Block.max_operations_ttl predecessor)
+  end >>= fun (live_blocks, live_operations) ->
+  Block_validation.check_liveness
+    ~live_operations ~live_blocks block_hash operations >>=? fun () ->
+  match bvp with
+  | Sequential vp ->
+      Seq_validator.apply_block vp
+        ~max_operations_ttl
+        chain_id ~predecessor_block_header
+        ~block_header operations
+

src/lib_shell/block_validator_process.mli

@@ -2,6 +2,7 @@
 (*                                                                           *)
 (* 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"),*)
@@ -23,24 +24,17 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-type kind =
+type validator_kind =
-  | Internal
+  | Internal of Context.index
 
 type t
 
-val init : context_root:string -> kind -> t Lwt.t
+val init : validator_kind -> t Lwt.t
 val close : t -> unit Lwt.t
 
-type application_result = {
-  validation_result: Tezos_protocol_environment_shell.validation_result ;
-  block_data: Secp256k1.watermark ;
-  ops_metadata: Secp256k1.watermark list list ;
-  context_hash: Context_hash.t ;
-}
-
 val apply_block :
   t ->
+  predecessor:State.Block.t ->
   Block_header.t ->
   Operation.t list list ->
-  State.Chain.t ->
+  Block_validation.result tzresult Lwt.t
-  application_result tzresult Lwt.t

src/lib_shell/dune

@@ -6,7 +6,8 @@
             tezos-rpc-http
             tezos-p2p
             tezos-shell-services
-            tezos-protocol-updater)
+            tezos-protocol-updater
+	    tezos-validation)
  (flags (:standard -w -9+27-30-32-40@8
                    -safe-string
                    -open Tezos_base__TzPervasives
@@ -14,7 +15,8 @@
                    -open Tezos_rpc_http
                    -open Tezos_p2p
                    -open Tezos_shell_services
-                   -open Tezos_protocol_updater)))
+                   -open Tezos_protocol_updater
+		   -open Tezos_validation)))
 
 (alias
  (name runtest_indent)

src/lib_shell/node.ml

@@ -189,14 +189,14 @@ let create
     | None -> true in
   init_p2p ~sandboxed p2p_params >>=? fun p2p ->
   State.init
-    ~store_root ~context_root ?patch_context genesis >>=? fun (state, mainchain_state) ->
+    ~store_root ~context_root ?patch_context
+    genesis >>=? fun (state, mainchain_state, context_index) ->
   may_update_checkpoint mainchain_state checkpoint >>= fun () ->
   let distributed_db = Distributed_db.create state p2p in
-  Validator_process.(init ~context_root Internal) >>= fun validation_process ->
   Validator.create state distributed_db
     peer_validator_limits
     block_validator_limits
-    validation_process
+    (Block_validator.Internal context_index)
     prevalidator_limits
     chain_validator_limits
   >>= fun validator ->

src/lib_shell/prevalidation.ml

@@ -311,7 +311,7 @@ let preapply ~predecessor ~timestamp ~protocol_data operations =
   Prevalidation.status validation_state >>=? fun { block_result ; _ } ->
   let pred_shell_header = State.Block.shell_header predecessor in
   let level = Int32.succ pred_shell_header.level in
-  Block_validator.may_patch_protocol
+  Block_validation.may_patch_protocol
     ~level block_result >>=? fun { fitness ; context ; message } ->
   State.Block.protocol_hash predecessor >>= fun pred_protocol ->
   Context.get_protocol context >>= fun protocol ->

src/lib_shell/state.ml

@@ -1299,7 +1299,7 @@ let init
   let main_chain = Chain_id.of_block_hash genesis.Chain.block in
   read global_store context_index main_chain >>=? fun state ->
   may_create_chain state main_chain genesis >>= fun main_chain_state ->
-  return (state, main_chain_state)
+  return (state, main_chain_state, context_index)
 
 let close { global_data } =
   Shared.use global_data begin fun { global_store } ->

src/lib_shell/state.mli

@@ -325,7 +325,7 @@ val init:
   store_root:string ->
   context_root:string ->
   Chain.genesis ->
-  (global_state * Chain.t) tzresult Lwt.t
+  (global_state * Chain.t * Context.index) tzresult Lwt.t
 
 val close:
   global_state -> unit Lwt.t

src/lib_shell/test/test_locator.ml

@@ -73,7 +73,7 @@ let init_chain base_dir : State.Chain.t Lwt.t =
   State.init
     ~store_root ~context_root state_genesis_block >>= function
   | Error _ -> Pervasives.failwith "read err"
-  | Ok (_state, chain) ->
+  | Ok (_state, chain, _index) ->
       Lwt.return chain
 
 

src/lib_shell/test/test_state.ml

@@ -180,7 +180,7 @@ let wrap_state_init f base_dir =
       ~context_mapsize:4_096_000_000L
       ~store_root
       ~context_root
-      genesis >>=? fun (state, chain) ->
+      genesis >>=? fun (state, chain, _index) ->
     build_example_tree chain >>= fun vblock ->
     f { state ; chain ; vblock } >>=? fun () ->
     return_unit

src/lib_shell/validator.ml

@@ -43,11 +43,11 @@ type t = {
 let create state db
     peer_validator_limits
     block_validator_limits
-    validation_process
+    block_validator_kind
     prevalidator_limits
     chain_validator_limits
   =
-  Block_validator.create block_validator_limits db validation_process >>= fun block_validator ->
+  Block_validator.create block_validator_limits db block_validator_kind >>= fun block_validator ->
   let valid_block_input = Lwt_watcher.create_input () in
   Lwt.return
     { state ; db ;

src/lib_shell/validator.mli

@@ -32,7 +32,7 @@ val create:
   Distributed_db.t ->
   Peer_validator.limits ->
   Block_validator.limits ->
-  Validator_process.t ->
+  Block_validator.validator_kind ->
   Prevalidator.limits ->
   Chain_validator.limits ->
   t Lwt.t

src/lib_shell/validator_process.ml

@@ -1,223 +0,0 @@
-(*****************************************************************************)
-(*                                                                           *)
-(* Open Source License                                                       *)
-(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.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.                                                 *)
-(*                                                                           *)
-(*****************************************************************************)
-
-type application_result = {
-  validation_result: Tezos_protocol_environment_shell.validation_result ;
-  block_data: Secp256k1.watermark ;
-  ops_metadata: Secp256k1.watermark list list ;
-  context_hash: Context_hash.t ;
-}
-
-type error +=
-  | Failed_to_checkout_context of Context_hash.t
-
-let () =
-  register_error_kind
-    `Permanent
-    ~id:"Validator_process.failed_to_checkout_context"
-    ~title: "Fail during checkout context"
-    ~description: "The context checkout failed using a given hash"
-    ~pp:(fun ppf (hash:Context_hash.t) ->
-        Format.fprintf ppf
-          "@[Failed to checkout the context with hash %a@]"
-          Context_hash.pp_short hash)
-    Data_encoding.(obj1 (req "hash" Context_hash.encoding))
-    (function
-      | Failed_to_checkout_context h -> Some h
-      | _ -> None)
-    (fun h -> Failed_to_checkout_context h)
-
-
-(** The standard block validation method *)
-module SeqValidator = struct
-
-  include Logging.Make (struct let name = "sequential validator process" end)
-
-  type validation_context = {
-    context_index : Context.index ;
-  }
-
-  type t = validation_context
-
-  let init context_root =
-    lwt_log_notice "Intialized" >>= fun _ ->
-    Context.init context_root >>= fun context_index ->
-    Lwt.return { context_index }
-
-  let close _ =
-    lwt_log_notice "Shutting down ..." >>= fun _ ->
-    Lwt.return ()
-
-  let get_context index hash =
-    Context.checkout index hash >>= function
-    | None -> fail (Failed_to_checkout_context hash)
-    | Some ctx -> return ctx
-
-  open Block_validator_errors
-
-  let invalid_block block error = Invalid_block { block ; error }
-
-  let apply_block
-      validator_process
-      (header : Block_header.t)
-      operations
-      chain_state =
-    State.Block.read
-      chain_state header.shell.predecessor >>=? fun pred ->
-    State.Block.context pred >>= fun pred_context ->
-    Context.get_protocol pred_context >>= fun pred_protocol_hash ->
-    let hash = Block_header.hash header in
-    let chain_id = State.Chain.id chain_state in
-    begin
-      match Registered_protocol.get pred_protocol_hash with
-      | None ->
-          fail (Unavailable_protocol { block = hash ;
-                                       protocol = pred_protocol_hash })
-      | Some p -> return p
-    end >>=? fun (module Proto) ->
-    let pred_header = State.Block.header pred in
-    get_context
-      validator_process.context_index
-      pred_header.shell.context >>=? fun pred_context ->
-    let pred_hash = State.Block.hash pred in
-    Context.reset_test_chain
-      pred_context pred_hash header.shell.timestamp >>= fun context ->
-    let max_operations_ttl = State.Block.max_operations_ttl pred in
-    let operation_hashes = List.map (List.map Operation.hash) operations in
-    begin
-      match
-        Data_encoding.Binary.of_bytes
-          Proto.block_header_data_encoding
-          header.protocol_data with
-      | None ->
-          fail (invalid_block hash Cannot_parse_block_header)
-      | Some protocol_data ->
-          return ({ shell = header.shell ; protocol_data } : Proto.block_header)
-    end >>=? fun header ->
-    mapi2_s (fun pass -> map2_s begin fun op_hash op ->
-        match
-          Data_encoding.Binary.of_bytes
-            Proto.operation_data_encoding
-            op.Operation.proto with
-        | None ->
-            fail (invalid_block hash (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 hash
-                 (Unallowed_pass { operation = op_hash ;
-                                   pass ; allowed_pass } )) >>=? fun () ->
-            return op
-      end)
-      operation_hashes
-      operations >>=? fun parsed_operations ->
-    (* TODO wrap 'proto_error' into 'block_error' *)
-    Proto.begin_application
-      ~chain_id: chain_id
-      ~predecessor_context:context
-      ~predecessor_timestamp:pred_header.shell.timestamp
-      ~predecessor_fitness:pred_header.shell.fitness
-      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, []) parsed_operations >>=? fun (state, ops_metadata) ->
-    let ops_metadata = List.rev ops_metadata in
-    Proto.finalize_block state >>=? fun (validation_result, block_data) ->
-    Context.get_protocol validation_result.context >>= fun new_protocol ->
-    let expected_proto_level =
-      if Protocol_hash.equal new_protocol Proto.hash then
-        pred_header.shell.proto_level
-      else
-        (pred_header.shell.proto_level + 1) mod 256 in
-    fail_when (header.shell.proto_level <> expected_proto_level)
-      (invalid_block hash @@  Invalid_proto_level {
-          found = header.shell.proto_level ;
-          expected = expected_proto_level ;
-        }) >>=? fun () ->
-    fail_when
-      Fitness.(validation_result.fitness <> header.shell.fitness)
-      (invalid_block hash @@ Invalid_fitness {
-          expected = 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 = hash ;
-                                         protocol = new_protocol })
-        | Some (module NewProto) ->
-            NewProto.init validation_result.context 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_data =
-      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:header.shell.timestamp
-      ?message:validation_result.message
-      validation_result.context >>= fun context_hash ->
-    return ({ validation_result ; block_data ;
-              ops_metadata ; context_hash })
-
-end
-
-type kind =
-  | Internal
-
-type t =
-  | Sequential of SeqValidator.t
-
-let init ~context_root = function
-  | Internal ->
-      SeqValidator.init context_root >>= fun v ->
-      Lwt.return (Sequential v)
-
-let close = function
-  | Sequential vp -> SeqValidator.close vp
-
-let apply_block = function
-  | Sequential vp -> SeqValidator.apply_block vp

src/lib_shell_services/block_validator_errors.ml

@@ -2,6 +2,7 @@
 (*                                                                           *)
 (* 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"),*)
@@ -254,6 +255,7 @@ type error +=
       { block: Block_hash.t ;
         expected: Operation_list_list_hash.t ;
         found: Operation_list_list_hash.t }
+  | Failed_to_checkout_context of Context_hash.t
 
 let () =
   Error_monad.register_error_kind
@@ -319,5 +321,20 @@ let () =
           Some (block, expected, found)
       | _ -> None)
     (fun (block, expected, found) ->
-       Inconsistent_operations_hash { block ; expected ; found })
+       Inconsistent_operations_hash { block ; expected ; found });
+  Error_monad.register_error_kind
+    `Permanent
+    ~id:"Validator_process.failed_to_checkout_context"
+    ~title: "Fail during checkout context"
+    ~description: "The context checkout failed using a given hash"
+    ~pp:(fun ppf (hash:Context_hash.t) ->
+        Format.fprintf ppf
+          "@[Failed to checkout the context with hash %a@]"
+          Context_hash.pp_short hash)
+    Data_encoding.(obj1 (req "hash" Context_hash.encoding))
+    (function
+      | Failed_to_checkout_context h -> Some h
+      | _ -> None)
+    (fun h -> Failed_to_checkout_context h)
 
+let invalid_block block error = Invalid_block { block ; error }

src/lib_shell_services/block_validator_errors.mli

@@ -2,6 +2,7 @@
 (*                                                                           *)
 (* 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"),*)
@@ -57,3 +58,6 @@ type error +=
       { block: Block_hash.t ;
         expected: Operation_list_list_hash.t ;
         found: Operation_list_list_hash.t }
+  | Failed_to_checkout_context of Context_hash.t
+
+val invalid_block : Block_hash.t -> block_error -> error

src/lib_validation/block_validation.ml

@@ -0,0 +1,279 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* 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

src/lib_validation/block_validation.mli

@@ -0,0 +1,52 @@
+(*****************************************************************************)
+(*                                                                           *)
+(* 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.                                                 *)
+(*                                                                           *)
+(*****************************************************************************)
+
+val may_patch_protocol:
+  level:Int32.t ->
+  Tezos_protocol_environment_shell.validation_result ->
+  Tezos_protocol_environment_shell.validation_result tzresult Lwt.t
+
+val check_liveness:
+  live_blocks:Block_hash.Set.t ->
+  live_operations:Operation_hash.Set.t ->
+  Block_hash.t ->
+  Operation.t list list ->
+  unit tzresult Lwt.t
+
+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 ;
+}
+
+val apply:
+  Chain_id.t ->
+  max_operations_ttl:int ->
+  predecessor_block_header:Block_header.t ->
+  predecessor_context:Context.t ->
+  block_header:Block_header.t ->
+  Operation.t list list -> result tzresult Lwt.t

src/lib_validation/dune

@@ -0,0 +1,18 @@
+(library
+ (name tezos_validation)
+ (public_name tezos-validation)
+ (libraries tezos-base
+	    tezos-storage
+	    tezos-shell-services
+	    tezos-protocol-updater)
+ (flags (:standard -w -9+27-30-32-40@8
+                   -safe-string
+                   -open Tezos_base__TzPervasives
+		   -open Tezos_storage
+		   -open Tezos_shell_services
+		   -open Tezos_protocol_updater)))
+
+(alias
+ (name runtest_indent)
+ (deps (glob_files *.ml{,i}))
+ (action (run bash %{libexec:tezos-stdlib:test-ocp-indent.sh} %{deps})))

src/lib_validation/tezos-validation.opam

@@ -0,0 +1,22 @@
+opam-version: "1.2"
+version: "dev"
+maintainer: "contact@tezos.com"
+authors: [ "Tezos devteam" ]
+homepage: "https://www.tezos.com/"
+bug-reports: "https://gitlab.com/tezos/tezos/issues"
+dev-repo: "https://gitlab.com/tezos/tezos.git"
+license: "MIT"
+depends: [
+  "ocamlfind" { build }
+  "dune" { build & = "1.0.1" }
+  "tezos-base"
+  "tezos-storage"
+  "tezos-shell-services"
+  "tezos-protocol-updater"
+]
+build: [
+  [ "dune" "build" "-p" name "-j" jobs ]
+]
+build-test: [
+  [ "dune" "runtest" "-p" name "-j" jobs ]
+]