Proto: prepare protocol interface for multipass validation

src/bin_client/test/demo/main.ml

@@ -93,6 +93,17 @@ let begin_application
   Fitness.to_int64 raw_block.shell.fitness >>=? fun fitness ->
   return { context ; fitness }
 
+let begin_partial_application
+    ~ancestor_context
+    ~predecessor_timestamp
+    ~predecessor_fitness
+    raw_block =
+  begin_application
+    ~predecessor_context:ancestor_context
+    ~predecessor_timestamp
+    ~predecessor_fitness
+    raw_block
+
 let begin_construction
     ~predecessor_context:context
     ~predecessor_timestamp:_

src/bin_client/test/test_injection.sh

@@ -31,7 +31,7 @@ done
 sleep 2
 
 # autogenerated from the demo source
-protocol_version="PrqKneMJTqCkD5bXFb4w3nidsW9kem1DjmmchwFTHqztK7V3QRq"
+protocol_version="PrqRSDRSu849eAgN6UQXcZBAsK3jCHY7g9nQ6HWXAGkmDY4ffCH"
 
 $admin_client inject protocol "$test_dir/demo"
 $admin_client list protocols

src/lib_protocol_environment/sigs/v1/updater.mli

@@ -138,12 +138,17 @@ module type PROTOCOL = sig
       function should run quickly, as its main use is to reject bad
       blocks from the chain as early as possible. The input context
       is the one resulting of an ancestor block of same protocol
-      version, not necessarily the one of its predecessor. *)
+      version. This ancestor of the current head is guaranteed to be
-  val precheck_block:
+      more recent than `last_allowed_fork_level`.
+
+      The resulting `validation_state` will be used for multi-pass
+      validation. *)
+  val begin_partial_application:
     ancestor_context: Context.t ->
-    ancestor_timestamp: Time.t ->
+    predecessor_timestamp: Time.t ->
+    predecessor_fitness: Fitness.t ->
     block_header ->
-    unit tzresult Lwt.t
+    validation_state tzresult Lwt.t
 
   (** The first step in a block validation sequence. Initializes a
       validation context for validating a block. Takes as argument the

src/lib_protocol_environment/tezos_protocol_environment.ml

@@ -81,11 +81,12 @@ module Make (Context : CONTEXT) = struct
     val compare_operations: operation -> operation -> int
     type validation_state
     val current_context: validation_state -> context tzresult Lwt.t
-    val precheck_block:
+    val begin_partial_application:
       ancestor_context: context ->
-      ancestor_timestamp: Time.t ->
+      predecessor_timestamp: Time.t ->
+      predecessor_fitness: Fitness.t ->
       block_header ->
-      unit tzresult Lwt.t
+      validation_state tzresult Lwt.t
     val begin_application:
       predecessor_context: context ->
       predecessor_timestamp: Time.t ->
@@ -631,11 +632,11 @@ module Make (Context : CONTEXT) = struct
 
     module Lift(P : Updater.PROTOCOL) = struct
       include P
-      let precheck_block
+      let begin_partial_application
-          ~ancestor_context ~ancestor_timestamp
+          ~ancestor_context ~predecessor_timestamp ~predecessor_fitness
           raw_block =
-        precheck_block
+        begin_partial_application
-          ~ancestor_context ~ancestor_timestamp
+          ~ancestor_context ~predecessor_timestamp ~predecessor_fitness
           raw_block >|= wrap_error
       let begin_application
           ~predecessor_context ~predecessor_timestamp

src/lib_protocol_environment/tezos_protocol_environment.mli

@@ -74,11 +74,12 @@ module Make (Context : CONTEXT) : sig
     val compare_operations: operation -> operation -> int
     type validation_state
     val current_context: validation_state -> context tzresult Lwt.t
-    val precheck_block:
+    val begin_partial_application:
       ancestor_context: context ->
-      ancestor_timestamp: Time.t ->
+      predecessor_timestamp: Time.t ->
+      predecessor_fitness: Fitness.t ->
       block_header ->
-      unit tzresult Lwt.t
+      validation_state tzresult Lwt.t
     val begin_application:
       predecessor_context: context ->
       predecessor_timestamp: Time.t ->

src/proto_alpha/lib_client/injection.ml

@@ -324,12 +324,15 @@ let inject_operation
           ~confirmations cctxt ~chain oph >>=? fun (h, i , j) ->
         Alpha_block_services.Operation.operation
           cctxt ~block:(`Hash (h, 0)) i j >>=? fun op' ->
-        let Operation_metadata receipt = op'.receipt in
+        match op'.receipt with
-        match Apply_operation_result.kind_equal_list contents receipt.contents
+        | No_operation_metadata ->
-        with
+            failwith "Internal error: unexpected receipt."
-        | Some Apply_operation_result.Eq ->
+        | Operation_metadata receipt ->
-            return (receipt : kind operation_metadata)
+            match Apply_operation_result.kind_equal_list contents receipt.contents
-        | None -> failwith "Internal error: unexpected receipt."
+            with
+            | Some Apply_operation_result.Eq ->
+                return (receipt : kind operation_metadata)
+            | None -> failwith "Internal error: unexpected receipt."
   end >>=? fun result ->
   cctxt#message
     "@[<v 2>This sequence of operations was run:@,%a@]"

src/proto_alpha/lib_protocol/src/alpha_context.mli

@@ -897,6 +897,7 @@ module Operation : sig
     proto: MBytes.t ;
   }
   val raw_encoding: raw Data_encoding.t
+  val contents_list_encoding: packed_contents_list Data_encoding.t
 
   type 'kind t = 'kind operation = {
     shell: Operation.shell_header ;

src/proto_alpha/lib_protocol/src/apply_operation_result.ml

@@ -702,7 +702,7 @@ let contents_and_result_list_encoding =
         | Manager_operation _, Cons_and_result (_, _, _) ->
             Contents_and_result_list (Cons_and_result (op, res, rest))
         | _ -> Pervasives.failwith "cannot decode ill-formed combined operation result" in
-  conv to_list of_list (list contents_and_result_encoding)
+  conv to_list of_list (Variable.list contents_and_result_encoding)
 
 type 'kind operation_metadata = {
   contents: 'kind contents_result_list ;
@@ -710,13 +710,27 @@ type 'kind operation_metadata = {
 
 type packed_operation_metadata =
   | Operation_metadata : 'kind operation_metadata -> packed_operation_metadata
+  | No_operation_metadata : packed_operation_metadata
 
 let operation_metadata_encoding =
   def "operation.alpha.result" @@
-  conv
+  union [
-    (fun (Operation_metadata { contents }) -> Contents_result_list contents)
+    case (Tag 0)
-    (fun (Contents_result_list contents) -> Operation_metadata { contents })
+      ~title:"Operation_metadata"
-    contents_result_list_encoding
+      contents_result_list_encoding
+      (function
+        | Operation_metadata { contents } ->
+            Some (Contents_result_list contents)
+        | _ -> None)
+      (fun (Contents_result_list contents) -> Operation_metadata { contents }) ;
+    case (Tag 1)
+      ~title:"No_operation_metadata"
+      empty
+      (function
+        | No_operation_metadata -> Some ()
+        | _ -> None)
+      (fun () -> No_operation_metadata) ;
+  ]
 
 type ('a, 'b) eq = Eq : ('a, 'a) eq
 
@@ -850,18 +864,36 @@ let rec unpack_contents_list :
 
 let operation_data_and_metadata_encoding =
   def "operation.alpha.operation_with_metadata" @@
-  conv
+  union [
-    (fun (Operation_data op, Operation_metadata res) ->
+    case (Tag 0)
-       match kind_equal_list op.contents res.contents with
+      ~title:"Operation_with_metadata"
-       | None -> Pervasives.failwith "cannot decode inconsistent combined operation result"
+      (obj2
-       | Some Eq ->
+         (req "contents" (dynamic_size contents_and_result_list_encoding))
-           (Contents_and_result_list
+         (opt "signature" Signature.encoding))
-              (pack_contents_list op.contents res.contents),
+      (function
-            op.signature))
+        | (Operation_data _, No_operation_metadata) -> None
-    (fun (Contents_and_result_list contents, signature) ->
+        | (Operation_data op, Operation_metadata res) ->
-       let op_contents, res_contents = unpack_contents_list contents in
+            match kind_equal_list op.contents res.contents with
-       (Operation_data { contents = op_contents ; signature },
+            | None -> Pervasives.failwith "cannot decode inconsistent combined operation result"
-        Operation_metadata { contents = res_contents }))
+            | Some Eq ->
-    (obj2
+                Some
-       (req "contents" contents_and_result_list_encoding)
+                  (Contents_and_result_list
-       (varopt "signature" Signature.encoding))
+                     (pack_contents_list op.contents res.contents),
+                   op.signature))
+      (fun (Contents_and_result_list contents, signature) ->
+         let op_contents, res_contents = unpack_contents_list contents in
+         (Operation_data { contents = op_contents ; signature },
+          Operation_metadata { contents = res_contents })) ;
+    case (Tag 1)
+      ~title:"Operation_without_metadata"
+      (obj2
+         (req "contents" (dynamic_size Operation.contents_list_encoding))
+         (opt "signature" Signature.encoding))
+      (function
+        | (Operation_data op, No_operation_metadata) ->
+            Some (Contents_list op.contents, op.signature)
+        | (Operation_data _, Operation_metadata _) ->
+            None)
+      (fun (Contents_list contents, signature) ->
+         (Operation_data { contents ; signature }, No_operation_metadata))
+  ]

src/proto_alpha/lib_protocol/src/apply_operation_result.mli

@@ -39,6 +39,7 @@ type 'kind operation_metadata = {
 
 and packed_operation_metadata =
   | Operation_metadata : 'kind operation_metadata -> packed_operation_metadata
+  | No_operation_metadata : packed_operation_metadata
 
 (** Result of applying a {!Operation.contents_list}. Follows the same structure. *)
 and 'kind contents_result_list =

src/proto_alpha/lib_protocol/src/main.ml

@@ -26,6 +26,7 @@ let operation_data_encoding = Alpha_context.Operation.protocol_data_encoding
 
 type operation_receipt = Apply_operation_result.packed_operation_metadata =
   | Operation_metadata : 'kind Apply_operation_result.operation_metadata -> operation_receipt
+  | No_operation_metadata: operation_receipt
 let operation_receipt_encoding =
   Apply_operation_result.operation_metadata_encoding
 
@@ -62,6 +63,10 @@ type validation_mode =
       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 ;
     }
@@ -80,24 +85,33 @@ type validation_state =
 let current_context { ctxt ; _ } =
   return (Alpha_context.finalize ctxt).context
 
-let precheck_block
+let begin_partial_application
-    ~ancestor_context:_
+    ~ancestor_context:ctxt
-    ~ancestor_timestamp:_
+    ~predecessor_timestamp
-    _block_header =
+    ~predecessor_fitness
-  (* TODO: decide what properties should be checked *)
-  return ()
-
-let begin_application
-    ~predecessor_context:ctxt
-    ~predecessor_timestamp:pred_timestamp
-    ~predecessor_fitness:pred_fitness
     (block_header : Alpha_context.Block_header.t) =
   let level = block_header.shell.level in
-  let fitness = pred_fitness 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 block_header pred_timestamp >>=? fun (ctxt, baker) ->
+    ctxt block_header predecessor_timestamp >>=? fun (ctxt, baker) ->
+  let mode =
+    Partial_application
+      { block_header ; baker = Signature.Public_key.hash baker } in
+  return { mode ; ctxt ; op_count = 0 }
+
+let begin_application
+    ~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 block_header predecessor_timestamp >>=? fun (ctxt, baker) ->
   let mode = Application { block_header ; baker = Signature.Public_key.hash baker } in
   return { mode ; ctxt ; op_count = 0 }
 
@@ -133,20 +147,31 @@ let begin_construction
 let apply_operation
     ({ mode ; ctxt ; op_count ; _ } as data)
     (operation : Alpha_context.packed_operation) =
-  let { shell ; protocol_data = Operation_data protocol_data } = operation in
+  match mode with
-  let operation : _ Alpha_context.operation = { shell ; protocol_data } in
+  | Partial_application _ when
-  let predecessor =
+      not (List.exists
-    match mode with
+             (Compare.Int.equal 0)
-    | Partial_construction { predecessor }
+             (Alpha_context.Operation.acceptable_passes operation)) ->
-    | Application
+      (* Multipass validation only considers operations in pass 0. *)
-        { block_header = { shell = { predecessor ; _ } ; _ } ; _ }
+      let op_count = op_count + 1 in
-    | Full_construction { predecessor ; _ } ->
+      return ({ data with ctxt ; op_count }, No_operation_metadata)
-        predecessor in
+  | _ ->
-  Apply.apply_operation ctxt Optimized predecessor
+      let { shell ; protocol_data = Operation_data protocol_data } = operation in
-    (Alpha_context.Operation.hash operation)
+      let operation : _ Alpha_context.operation = { shell ; protocol_data } in
-    operation >>=? fun (ctxt, result) ->
+      let predecessor =
-  let op_count = op_count + 1 in
+        match mode with
-  return ({ data with ctxt ; op_count }, Operation_metadata result)
+        | Partial_application
+            { block_header = { shell = { predecessor ; _ } ; _ } ; _ }
+        | Partial_construction { predecessor }
+        | Application
+            { block_header = { shell = { predecessor ; _ } ; _ } ; _ }
+        | Full_construction { predecessor ; _ } ->
+            predecessor in
+      Apply.apply_operation ctxt Optimized predecessor
+        (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
@@ -163,6 +188,12 @@ let finalize_block { mode ; ctxt ; op_count } =
       let ctxt = Alpha_context.finalize ctxt in
       return (ctxt, { Alpha_context.Block_header.baker ; level ;
                       voting_period_kind })
+  | 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, { Alpha_context.Block_header.baker ; level ;
+                      voting_period_kind })
   | Application
       { baker ;  block_header = { protocol_data = { contents = protocol_data ; _ } ; _ } }
   | Full_construction { protocol_data ; baker ; _ } ->

src/proto_alpha/lib_protocol/src/main.mli

@@ -14,6 +14,10 @@ type validation_mode =
       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 ;
     }

src/proto_alpha/lib_protocol/src/operation_repr.ml

@@ -592,6 +592,7 @@ end
 
 let encoding = Encoding.operation_encoding
 let contents_encoding = Encoding.contents_encoding
+let contents_list_encoding = Encoding.contents_list_encoding
 let protocol_data_encoding = Encoding.protocol_data_encoding
 let unsigned_operation_encoding = Encoding.unsigned_operation_encoding
 let internal_operation_encoding = Encoding.internal_operation_encoding

src/proto_alpha/lib_protocol/src/operation_repr.mli

@@ -149,6 +149,7 @@ val manager_kind: 'kind manager_operation -> 'kind Kind.manager
 
 val encoding: packed_operation Data_encoding.t
 val contents_encoding: packed_contents Data_encoding.t
+val contents_list_encoding: packed_contents_list Data_encoding.t
 val protocol_data_encoding: packed_protocol_data Data_encoding.t
 val unsigned_operation_encoding: (Operation.shell_header * packed_contents_list) Data_encoding.t
 

src/proto_demo/lib_protocol/src/main.ml

@@ -80,13 +80,6 @@ module Fitness = struct
 
 end
 
-let precheck_block
-    ~ancestor_context:_
-    ~ancestor_timestamp:_
-    (raw_block: block_header) =
-  Fitness.to_int64 raw_block.shell.fitness >>=? fun _ ->
-  return ()
-
 let begin_application
     ~predecessor_context:context
     ~predecessor_timestamp:_
@@ -95,6 +88,17 @@ let begin_application
   Fitness.to_int64 raw_block.shell.fitness >>=? fun fitness ->
   return { context ; fitness }
 
+let begin_partial_application
+    ~ancestor_context
+    ~predecessor_timestamp
+    ~predecessor_fitness
+    block_header =
+  begin_application
+    ~predecessor_context:ancestor_context
+    ~predecessor_timestamp
+    ~predecessor_fitness
+    block_header
+
 let begin_construction
     ~predecessor_context:context
     ~predecessor_timestamp:_

src/proto_genesis/lib_protocol/src/main.ml

@@ -92,14 +92,9 @@ type validation_state = Updater.validation_result
 let current_context ({ context ; _ } : validation_state) =
   return context
 
-let precheck_block
-    ~ancestor_context:_
-    ~ancestor_timestamp:_
-    _block_header =
-  return ()
-
 (* temporary hardcoded key to be removed... *)
 let protocol_parameters_key = [ "protocol_parameters" ]
+
 let prepare_application ctxt command level timestamp fitness =
   match command with
   | Data.Command.Activate { protocol = hash ; fitness ; protocol_parameters } ->
@@ -131,6 +126,17 @@ let begin_application
   prepare_application ctxt block_header.protocol_data.command
     block_header.shell.level block_header.shell.timestamp block_header.shell.fitness
 
+let begin_partial_application
+    ~ancestor_context
+    ~predecessor_timestamp
+    ~predecessor_fitness
+    block_header =
+  begin_application
+    ~predecessor_context:ancestor_context
+    ~predecessor_timestamp
+    ~predecessor_fitness
+    block_header
+
 let begin_construction
     ~predecessor_context:ctxt
     ~predecessor_timestamp:_