Tests/helpers: rework block to ease arbitrary signatures

src/proto_alpha/lib_protocol/test/helpers/block.ml

@@ -78,6 +78,7 @@ let get_next_baker ?(policy = By_priority 0) = dispatch_policy policy
 module Forge = struct
 
   type header = {
+    baker : public_key_hash ;   (* the signer of the block *)
     shell : Block_header.shell_header ;
     contents : Block_header.contents ;
   }
@@ -85,17 +86,16 @@ module Forge = struct
   let default_proof_of_work_nonce =
     MBytes.create Constants.proof_of_work_nonce_size
 
-  let make_header
+  let make_contents
       ?(proof_of_work_nonce = default_proof_of_work_nonce)
-      ~priority ~seed_nonce_hash
+      ~priority ~seed_nonce_hash () =
-      ~level ~predecessor ~timestamp ~fitness ~operations_hash () =
+    Block_header.{ priority ;
-    let contents = Block_header.{
-        priority ;
                    proof_of_work_nonce ;
-        seed_nonce_hash ;
+                   seed_nonce_hash }
-      }
+
-    in
+  let make_shell
-    let shell = Tezos_base.Block_header.{
+      ~level ~predecessor ~timestamp ~fitness ~operations_hash =
+    Tezos_base.Block_header.{
       level ;
       predecessor ;
       timestamp ;
@@ -106,27 +106,14 @@ module Forge = struct
       validation_passes = 0 ;
       context = Context_hash.zero ;
     }
-    in
-    { shell ; contents }
 
-  let set_seed_nonce_hash seed_nonce_hash { shell ; contents } =
+  let set_seed_nonce_hash seed_nonce_hash { baker ; shell ; contents } =
-    { shell ; contents = { contents with seed_nonce_hash } }
+    { baker ; shell ; contents = { contents with seed_nonce_hash } }
 
-  let sign_header { shell ; contents } pred =
+  let set_baker baker header = { header with baker }
-    (* Finds the baker that should sign from the header *)
+
-    let baker_of_a_block header =
+  let sign_header { baker ; shell ; contents } =
-      let priority = header.contents.priority in
+    Account.find baker >>=? fun delegate ->
-      Alpha_services.Delegate.Baking_rights.get rpc_ctxt
-        ~all:true
-        ~max_priority:(priority+1)
-        pred >>=? fun bakers ->
-      let { Alpha_services.Delegate.Baking_rights.delegate = pkh } =
-        List.find
-          (fun { Alpha_services.Delegate.Baking_rights.priority = p } -> p = priority)
-          bakers in
-      Account.find pkh
-    in
-    baker_of_a_block { shell ; contents } >>=? fun delegate ->
     let unsigned_bytes =
       Data_encoding.Binary.to_bytes_exn
         Block_header.unsigned_encoding
@@ -138,7 +125,7 @@ module Forge = struct
   let forge_header
       ?(policy = By_priority 0)
       ?(operations = []) pred =
-    dispatch_policy policy pred >>=? fun (_, priority, timestamp) ->
+    dispatch_policy policy pred >>=? fun (pkh, priority, timestamp) ->
     let level = Int32.succ pred.header.shell.level in
     begin
       match Fitness_repr.to_int64 pred.header.shell.fitness with
@@ -155,10 +142,10 @@ module Forge = struct
     let hashes = List.map Operation.hash_packed operations in
     let operations_hash = Operation_list_list_hash.compute
         [Operation_list_hash.compute hashes] in
-    let header = make_header
+    let shell = make_shell ~level ~predecessor:pred.hash
-        ~priority ~level ~predecessor:pred.hash ~timestamp ~fitness
+        ~timestamp ~fitness ~operations_hash in
-        ~seed_nonce_hash ~operations_hash () in
+    let contents = make_contents ~priority ~seed_nonce_hash () in
-    return header
+    return { baker = pkh ; shell ; contents }
 
   (* compatibility only, needed by incremental *)
   let contents
@@ -296,20 +283,18 @@ let genesis
   let hash =
     Block_hash.of_b58check_exn "BLockGenesisGenesisGenesisGenesisGenesisCCCCCeZiLHU"
   in
-  let header =
+  let shell = Forge.make_shell
-    Forge.make_header
       ~level:0l
       ~predecessor:hash
       ~timestamp:Time.epoch
       ~fitness: (Fitness_repr.from_int64 0L)
-      ~priority: 0
+      ~operations_hash: Operation_list_list_hash.zero in
-      ~seed_nonce_hash:None
+  let contents = Forge.make_contents
-      ~operations_hash: Operation_list_list_hash.zero
+      ~priority:0
-      ()
+      ~seed_nonce_hash:None () in
-  in
   initial_context
     constants
-    header.shell
+    shell
     commitments
     initial_accounts
     security_deposit_ramp_up_cycles
@@ -318,9 +303,9 @@ let genesis
   let block =
     { hash ;
       header = {
-        shell = header.shell ;
+        shell = shell ;
         protocol_data = {
-          contents = header.contents ;
+          contents = contents ;
           signature = Signature.zero ;
         } ;
       };
@@ -332,8 +317,7 @@ let genesis
 
 (********* Baking *************)
 
-let apply (header:Forge.header) ?(operations = []) pred =
+let apply header ?(operations = []) pred =
-  Forge.sign_header header pred >>=? fun header ->
   begin
     let open Alpha_environment.Error_monad in
     Proto_alpha.Main.begin_application
@@ -361,6 +345,7 @@ let bake ?policy ?operation ?operations pred =
     | None, None -> None
   in
   Forge.forge_header ?policy ?operations pred >>=? fun header ->
+  Forge.sign_header header >>=? fun header ->
   apply header ?operations pred
 
 (* This function is duplicated from Context to avoid a cyclic dependency *)

src/proto_alpha/lib_protocol/test/helpers/block.mli

@@ -20,7 +20,11 @@ type block = t
 
 val rpc_ctxt: t Alpha_environment.RPC_context.simple
 
-(** Policies to select the next baker *)
+(** Policies to select the next baker:
+    - [By_priority p] selects the baker at priority [p]
+    - [By_account pkh] selects the first slot for baker [pkh]
+    - [Excluding pkhs] selects the first baker that doesn't belong to [pkhs]
+*)
 type baker_policy =
   | By_priority of int
   | By_account of public_key_hash
@@ -49,10 +53,19 @@ module Forge : sig
     ?operations: Operation.packed list ->
     t -> header tzresult Lwt.t
 
-  (** Sets seed_nonce_hash of a header *)
+  (** Sets uniquely seed_nonce_hash of a header *)
   val set_seed_nonce_hash:
-    Nonce_hash.t option ->
+    Nonce_hash.t option -> header -> header
-    header -> header
+
+  (** Sets the baker that will sign the header to an arbitrary pkh *)
+  val set_baker:
+    public_key_hash -> header -> header
+
+  (** Signs the header with the key of the baker configured in the header.
+      The header can no longer be modified, only applied. *)
+  val sign_header:
+    header ->
+    Block_header.block_header tzresult Lwt.t
 
 end
 
@@ -88,16 +101,20 @@ val genesis:
   ?no_reward_cycles: int option ->
   (Account.t * Tez_repr.tez) list -> block tzresult Lwt.t
 
-(** Applies a header and its operations to a block and obtains a new block *)
+(** Applies a signed header and its operations to a block and
+    obtains a new block *)
 val apply:
-  Forge.header ->
+  Block_header.block_header ->
   ?operations: Operation.packed list ->
   t -> t tzresult Lwt.t
 
 (**
    [bake b] returns a block [b'] which has as predecessor block [b].
    Optional parameter [policy] allows to pick the next baker in several ways.
-   This function bundles together [forge_header] and [apply].
+   This function bundles together [forge_header], [sign_header] and [apply].
+   These functions should be used instead of bake to craft unusual blocks for
+   testing together with setters for properties of the headers.
+   For examples see seed.ml or double_baking.ml
 *)
 val bake:
   ?policy: baker_policy ->

src/proto_alpha/lib_protocol/test/seed.ml

@@ -22,7 +22,8 @@ let no_commitment () =
 
   (* Forge a block with empty commitment and apply it *)
   Block.Forge.forge_header b >>=? fun header ->
-  let header = Block.Forge.set_seed_nonce_hash None header in
+  Block.Forge.set_seed_nonce_hash None header |>
+  Block.Forge.sign_header >>=? fun header ->
   Block.apply header b >>= fun e ->
 
   let invalid_commitment = function