Baking: handle validation passes

src/lib_shell/node_rpc.ml

@@ -138,10 +138,6 @@ let register_bi_dir node dir =
       Block_services.preapply implementation in
   dir
 
-let ops_dir _node =
-  let ops_dir = RPC_directory.empty in
-  ops_dir
-
 let rec insert_future_block (bi: Block_services.block_info) = function
   | [] -> [bi]
   | ({timestamp} as head: Block_services.block_info) :: tail as all ->

src/proto_alpha/lib_client/client_baking_forge.ml

@@ -94,6 +94,20 @@ let () =
       | _ -> None)
     (fun (hash, err) -> Failed_to_preapply (hash, err))
 
+let classify_operations (ops: Operation.raw list) =
+  let t = Array.make (List.length Proto_alpha.Main.validation_passes) [] in
+  List.iter
+    (fun op ->
+       let h = Operation.hash_raw op in
+       match Operation.parse h op with
+       | Ok o ->
+           List.iter
+             (fun pass -> t.(pass) <- op :: t.(pass))
+             (Proto_alpha.Main.acceptable_passes o)
+       | Error _ -> ())
+    ops ;
+  Array.fold_right (fun ops acc -> List.rev ops :: acc) t []
+
 let forge_block cctxt block
     ?force
     ?operations ?(best_effort = operations = None) ?(sort = best_effort)
@@ -114,7 +128,8 @@ let forge_block cctxt block
             (Preapply_result.operations ops)
             pendings in
         return ops
-    | Some operations -> return operations
+    | Some operations ->
+        return operations
   end >>=? fun operations ->
   begin
     match priority with
@@ -159,28 +174,53 @@ let forge_block cctxt block
   end >>=? fun timestamp ->
   let request = List.length operations in
   let proto_header = forge_faked_proto_header ~priority ~seed_nonce_hash in
+  let operations = classify_operations operations in
   Client_node_rpcs.Blocks.preapply
-    cctxt block ~timestamp ~sort ~proto_header [operations] >>=?
+    cctxt block ~timestamp ~sort ~proto_header operations >>=?
   fun { operations = result ; shell_header } ->
-  let result = List.hd result in
+  let valid = List.fold_left (fun acc r -> acc + List.length r.Preapply_result.applied) 0 result in
-  let valid = List.length result.applied in
   lwt_log_info "Found %d valid operations (%d refused) for timestamp %a"
     valid (request - valid)
     Time.pp_hum timestamp >>= fun () ->
   lwt_log_info "Computed fitness %a"
     Fitness.pp shell_header.fitness >>= fun () ->
   if best_effort
-  || ( Operation_hash.Map.is_empty result.refused
+  || List.for_all (fun l ->
-       && Operation_hash.Map.is_empty result.branch_refused
+         Operation_hash.Map.is_empty l.Preapply_result.refused
-       && Operation_hash.Map.is_empty result.branch_delayed ) then
+         && Operation_hash.Map.is_empty l.branch_refused
+         && Operation_hash.Map.is_empty l.branch_delayed )
+       result
+  then
     let operations =
       if not best_effort then operations
-      else List.map snd result.applied in
+      else List.map (fun l -> List.map snd l.Preapply_result.applied) result in
     Client_node_rpcs.Blocks.info cctxt block >>=? fun {net_id} ->
     inject_block cctxt
       ?force ~net_id ~shell_header ~priority ~seed_nonce_hash ~src_sk
-      [operations]
+      operations
   else
+    let result =
+      let merge old neu =
+        let open Preapply_result in
+        let merge _key a b =
+          match a, b with
+          | None, None -> None
+          | Some x, None -> Some x
+          | _, Some y -> Some y in
+        { applied = [] ;
+          refused =
+            Operation_hash.Map.merge merge
+              old.refused
+              neu.refused ;
+          branch_refused =
+            Operation_hash.Map.merge merge
+              old.branch_refused
+              neu.branch_refused ;
+          branch_delayed =
+            Operation_hash.Map.merge merge
+              old.branch_delayed
+              neu.branch_delayed } in
+      List.fold_left merge Preapply_result.empty result in
     Lwt.return_error @@
     List.filter_map
       (fun op ->
@@ -194,8 +234,7 @@ let forge_block cctxt block
          try Some (Failed_to_preapply
                      (op, snd @@ Operation_hash.Map.find h result.branch_delayed))
          with Not_found -> None)
-      operations
+      (List.concat operations)
-
 
 (** Worker *)
 

src/proto_alpha/lib_client/client_baking_forge.mli

@@ -24,7 +24,7 @@ val inject_block:
   priority:int ->
   seed_nonce_hash:Nonce_hash.t ->
   src_sk:Client_keys.sk_locator ->
-  Tezos_base.Operation.t list list ->
+  Operation.raw list list ->
   Block_hash.t tzresult Lwt.t
 (** [inject_block cctxt blk ?force ~priority ~timestamp ~fitness
     ~seed_nonce ~src_sk ops] tries to inject a block in the node. If
@@ -39,7 +39,7 @@ val forge_block:
   #Client_rpcs.ctxt ->
   Client_proto_rpcs.block ->
   ?force:bool ->
-  ?operations:Tezos_base.Operation.t list ->
+  ?operations:Operation.raw list ->
   ?best_effort:bool ->
   ?sort:bool ->
   ?timestamp:Time.t ->

src/proto_alpha/lib_protocol/src/main.mli

@@ -9,4 +9,4 @@
 
 (** Tezos Protocol Implementation - Protocol Signature Instance *)
 
-include Updater.PROTOCOL
+include Updater.PROTOCOL with type operation = Tezos_context.Operation.t