Shell: enforce the allowed passes of an operation

src/lib_error_monad/error_monad.ml

@@ -263,6 +263,17 @@ module Make() = struct
         map2_s f t1 t2 >>=? fun rt ->
         return (rh :: rt)
 
+  let mapi2_s f l1 l2 =
+    let rec mapi2_s i f l1 l2 =
+      match l1, l2 with
+      | [], [] -> return []
+      | _ :: _, [] | [], _ :: _ -> invalid_arg "Error_monad.mapi2_s"
+      | h1 :: t1, h2 :: t2 ->
+          f i h1 h2 >>=? fun rh ->
+          mapi2_s (i+1) f t1 t2 >>=? fun rt ->
+          return (rh :: rt) in
+    mapi2_s 0 f l1 l2
+
   let rec map2 f l1 l2 =
     match l1, l2 with
     | [], [] -> Ok []

src/lib_error_monad/error_monad_sig.ml

@@ -130,11 +130,12 @@ module type S = sig
   (** A {!List.map2} in the monad *)
   val map2 :
     ('a -> 'b -> 'c tzresult) -> 'a list -> 'b list -> 'c list tzresult
-
-  (** A {!List.map2} in the monad *)
   val map2_s :
     ('a -> 'b -> 'c tzresult Lwt.t) -> 'a list -> 'b list ->
     'c list tzresult Lwt.t
+  val mapi2_s :
+    (int -> 'a -> 'b -> 'c tzresult Lwt.t) -> 'a list -> 'b list ->
+    'c list tzresult Lwt.t
 
   (** A {!List.filter_map} in the monad *)
   val filter_map_s :

src/lib_shell/block_validator.ml

@@ -142,9 +142,15 @@ let apply_block
     operations Proto.validation_passes >>=? fun () ->
   let operation_hashes = List.map (List.map Operation.hash) operations in
   check_liveness net_state pred hash operation_hashes operations >>=? fun () ->
-  map2_s (map2_s begin fun op_hash raw ->
+  mapi2_s (fun pass -> map2_s begin fun op_hash raw ->
       Lwt.return (Proto.parse_operation op_hash raw)
-      |> trace (invalid_block hash (Cannot_parse_operation op_hash))
+      |> trace (invalid_block hash (Cannot_parse_operation op_hash)) >>=? fun op ->
+      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 ->

src/lib_shell_services/block_validator_errors.ml

@@ -27,6 +27,9 @@ type block_error =
   | Too_many_operations of { pass: int; found: int; max: int }
   | Oversized_operation of { operation: Operation_hash.t;
                              size: int; max: int }
+  | Unallowed_pass of { operation: Operation_hash.t ;
+                        pass: int ;
+                        allowed_pass: int list }
 
 let block_error_encoding =
   let open Data_encoding in
@@ -132,6 +135,18 @@ let block_error_encoding =
           | _ -> None)
         (fun ((), operation, size, max) ->
            Oversized_operation { operation ; size ; max }) ;
+      case (Tag 11)
+        (obj4
+           (req "error" (constant "invalid_pass"))
+           (req "operation" Operation_hash.encoding)
+           (req "pass" uint8)
+           (req "allowed_pass" (list uint8)))
+        (function
+          | Unallowed_pass { operation ; pass ; allowed_pass } ->
+              Some ((), operation, pass, allowed_pass)
+          | _ -> None)
+        (fun ((), operation, pass, allowed_pass) ->
+           Unallowed_pass { operation ; pass ; allowed_pass }) ;
     ]
 
 let pp_block_error ppf = function
@@ -192,6 +207,12 @@ let pp_block_error ppf = function
       Format.fprintf ppf
         "Oversized operation %a (size: %d, max: %d)"
         Operation_hash.pp_short operation size max
+  | Unallowed_pass { operation ; pass ; allowed_pass } ->
+      Format.fprintf ppf
+        "Operation %a included in validation pass %d, \
+        \ while only the following passes are allowed: @[<h>%a@]"
+        Operation_hash.pp_short operation pass
+        Format.(pp_print_list pp_print_int) allowed_pass
 
 type error +=
   | Invalid_block of

src/lib_shell_services/block_validator_errors.mli

@@ -27,6 +27,9 @@ type block_error =
   | Too_many_operations of { pass: int; found: int; max: int }
   | Oversized_operation of { operation: Operation_hash.t;
                              size: int; max: int }
+  | Unallowed_pass of { operation: Operation_hash.t ;
+                        pass: int ;
+                        allowed_pass: int list }
 
 type error +=
   | Invalid_block of