From 2be83eafc195e93dcaf3b608aac9ceddfcda2041 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= <gregoire.henry@tezos.com>
Date: Fri, 23 Feb 2018 16:22:10 -0500
Subject: [PATCH] Alpha: allow seed's nonce commitment only once every
 'blocks_per_commitment'

---
 .../lib_baking/client_baking_forge.ml         | 20 ++++++++----
 .../lib_baking/client_baking_forge.mli        |  4 +--
 .../lib_baking/client_baking_lib.ml           | 24 ++++++++++----
 .../lib_baking/test/proto_alpha_helpers.ml    | 22 ++++++++-----
 .../lib_protocol/src/alpha_context.mli        |  3 +-
 .../lib_protocol/src/alpha_services.ml        |  2 +-
 src/proto_alpha/lib_protocol/src/apply.ml     | 32 +++++++++++++++++--
 .../lib_protocol/src/block_header_repr.ml     | 20 +++++++-----
 .../lib_protocol/src/block_header_repr.mli    |  2 +-
 .../lib_protocol/src/helpers_services.ml      |  7 ++--
 .../lib_protocol/src/helpers_services.mli     |  2 +-
 .../lib_protocol/src/level_repr.ml            | 31 ++++++++++++------
 .../lib_protocol/src/level_repr.mli           |  2 ++
 .../lib_protocol/src/level_storage.ml         | 14 ++++++++
 .../lib_protocol/src/level_storage.mli        |  3 ++
 .../lib_protocol/src/raw_context.ml           |  5 +--
 .../lib_protocol/src/seed_storage.ml          |  2 +-
 .../lib_protocol/src/services_registration.ml |  6 ++++
 .../test/helpers/helpers_block.ml             | 10 ++++--
 .../test/helpers/helpers_block.mli            |  2 +-
 .../lib_protocol/test/helpers/helpers_init.ml |  2 +-
 21 files changed, 156 insertions(+), 59 deletions(-)

diff --git a/src/proto_alpha/lib_baking/client_baking_forge.ml b/src/proto_alpha/lib_baking/client_baking_forge.ml
index d9432c960..823fcb9e0 100644
--- a/src/proto_alpha/lib_baking/client_baking_forge.ml
+++ b/src/proto_alpha/lib_baking/client_baking_forge.ml
@@ -62,7 +62,7 @@ let assert_valid_operations_hash shell_header operations =
 
 let inject_block cctxt
     ?force ?chain_id
-    ~shell_header ~priority ~seed_nonce_hash ~src_sk operations =
+    ~shell_header ~priority ?seed_nonce_hash ~src_sk operations =
   assert_valid_operations_hash shell_header operations >>=? fun () ->
   let block = `Hash shell_header.Tezos_base.Block_header.predecessor in
   forge_block_header cctxt block
@@ -113,7 +113,7 @@ let forge_block cctxt block
     ?operations ?(best_effort = operations = None) ?(sort = best_effort)
     ?timestamp
     ~priority
-    ~seed_nonce_hash ~src_sk () =
+    ?seed_nonce_hash ~src_sk () =
   let block = Block_services.last_baked_block block in
   begin
     match operations with
@@ -196,7 +196,7 @@ let forge_block cctxt block
       else List.map (fun l -> List.map snd l.Preapply_result.applied) result in
     Block_services.info cctxt block >>=? fun {chain_id} ->
     inject_block cctxt
-      ?force ~chain_id ~shell_header ~priority ~seed_nonce_hash ~src_sk
+      ?force ~chain_id ~shell_header ~priority ?seed_nonce_hash ~src_sk
       operations
   else
     let result =
@@ -467,6 +467,7 @@ let bake (cctxt : #Proto_alpha.full) state =
   filter_map_s
     (fun (timestamp, (bi, priority, delegate)) ->
        let block = `Hash bi.Client_baking_blocks.hash in
+       Alpha_services.Context.next_level cctxt block >>=? fun next_level ->
        let timestamp =
          if Block_hash.equal bi.Client_baking_blocks.hash state.genesis then
            Time.now ()
@@ -484,6 +485,11 @@ let bake (cctxt : #Proto_alpha.full) state =
          Operation_hash.Map.(fold add)
            ops (Preapply_result.operations res) in
        let request = List.length operations in
+       let seed_nonce_hash =
+         if next_level.expected_commitment then
+           Some seed_nonce_hash
+         else
+           None in
        let protocol_data =
          forge_faked_protocol_data ~priority ~seed_nonce_hash in
        let operations = classify_operations operations in
@@ -507,11 +513,11 @@ let bake (cctxt : #Proto_alpha.full) state =
            let operations =
              List.map (fun l -> List.map snd l.Preapply_result.applied) operations in
            return
-             (Some (bi, priority, shell_header, operations, delegate)))
+             (Some (bi, priority, shell_header, operations, delegate, seed_nonce_hash)))
     slots >>=? fun candidates ->
   let candidates =
     List.sort
-      (fun (_,_,h1,_,_) (_,_,h2,_,_) ->
+      (fun (_,_,h1,_,_,_) (_,_,h2,_,_,_) ->
          match
            Fitness.compare h1.Tezos_base.Block_header.fitness h2.fitness
          with
@@ -520,7 +526,7 @@ let bake (cctxt : #Proto_alpha.full) state =
          | cmp -> ~- cmp)
       candidates in
   match candidates with
-  | (bi, priority, shell_header, operations, delegate) :: _
+  | (bi, priority, shell_header, operations, delegate, seed_nonce_hash) :: _
     when Fitness.compare state.best.fitness shell_header.fitness < 0 ||
          (Fitness.compare state.best.fitness shell_header.fitness = 0 &&
           Time.compare shell_header.timestamp state.best.timestamp < 0) -> begin
@@ -532,7 +538,7 @@ let bake (cctxt : #Proto_alpha.full) state =
       Client_keys.get_key cctxt delegate >>=? fun (_,_,src_sk) ->
       inject_block cctxt
         ~force:true ~chain_id:bi.chain_id
-        ~shell_header ~priority ~seed_nonce_hash ~src_sk
+        ~shell_header ~priority ?seed_nonce_hash ~src_sk
         operations
       |> trace_exn (Failure "Error while injecting block") >>=? fun block_hash ->
       State.record_block cctxt level block_hash seed_nonce
diff --git a/src/proto_alpha/lib_baking/client_baking_forge.mli b/src/proto_alpha/lib_baking/client_baking_forge.mli
index 97db339c5..d0d59ba21 100644
--- a/src/proto_alpha/lib_baking/client_baking_forge.mli
+++ b/src/proto_alpha/lib_baking/client_baking_forge.mli
@@ -22,7 +22,7 @@ val inject_block:
   ?chain_id:Chain_id.t ->
   shell_header:Block_header.shell_header ->
   priority:int ->
-  seed_nonce_hash:Nonce_hash.t ->
+  ?seed_nonce_hash:Nonce_hash.t ->
   src_sk:Client_keys.sk_locator ->
   Operation.raw list list ->
   Block_hash.t tzresult Lwt.t
@@ -44,7 +44,7 @@ val forge_block:
   ?sort:bool ->
   ?timestamp:Time.t ->
   priority:[`Set of int | `Auto of (public_key_hash * int option * bool)] ->
-  seed_nonce_hash:Nonce_hash.t ->
+  ?seed_nonce_hash:Nonce_hash.t ->
   src_sk:Client_keys.sk_locator ->
   unit ->
   Block_hash.t tzresult Lwt.t
diff --git a/src/proto_alpha/lib_baking/client_baking_lib.ml b/src/proto_alpha/lib_baking/client_baking_lib.ml
index ddb1f863d..dbde14773 100644
--- a/src/proto_alpha/lib_baking/client_baking_lib.ml
+++ b/src/proto_alpha/lib_baking/client_baking_lib.ml
@@ -12,6 +12,7 @@ open Alpha_context
 
 let bake_block (cctxt : #Proto_alpha.full) block
     ?force ?max_priority ?(free_baking=false) ?src_sk delegate =
+  let block = Block_services.last_baked_block block in
   begin
     match src_sk with
     | None ->
@@ -19,17 +20,26 @@ let bake_block (cctxt : #Proto_alpha.full) block
         return src_sk
     | Some sk -> return sk
   end >>=? fun src_sk ->
-  Alpha_services.Context.level cctxt block >>=? fun level ->
-  let level = Raw_level.succ level.level in
-  let seed_nonce = Client_baking_forge.generate_seed_nonce () in
-  let seed_nonce_hash = Nonce.hash seed_nonce in
+  Alpha_services.Context.next_level cctxt block >>=? fun level ->
+  let seed_nonce, seed_nonce_hash =
+    if level.expected_commitment then
+      let seed_nonce = Client_baking_forge.generate_seed_nonce () in
+      let seed_nonce_hash = Nonce.hash seed_nonce in
+      Some seed_nonce, Some seed_nonce_hash
+    else
+      None, None in
   Client_baking_forge.forge_block cctxt
     ~timestamp:(Time.now ())
     ?force
-    ~seed_nonce_hash ~src_sk block
+    ?seed_nonce_hash ~src_sk block
     ~priority:(`Auto (delegate, max_priority, free_baking)) () >>=? fun block_hash ->
-  Client_baking_forge.State.record_block cctxt level block_hash seed_nonce
-  |> trace_exn (Failure "Error while recording block") >>=? fun () ->
+  begin
+    match seed_nonce with
+    | None -> return ()
+    | Some seed_nonce ->
+        Client_baking_forge.State.record_block cctxt level.level block_hash seed_nonce
+        |> trace_exn (Failure "Error while recording block")
+  end >>=? fun () ->
   cctxt#message "Injected block %a" Block_hash.pp_short block_hash >>= fun () ->
   return ()
 
diff --git a/src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml b/src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml
index 86989e80c..06bf608b7 100644
--- a/src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml
+++ b/src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml
@@ -423,24 +423,30 @@ end
 module Baking = struct
 
   let bake block (contract: Account.t) operations =
-    let seed_nonce =
-      match Nonce.of_bytes @@
-        Rand.generate Constants.nonce_length with
-      | Error _ -> assert false
-      | Ok nonce -> nonce in
-    let seed_nonce_hash = Nonce.hash seed_nonce in
+    let ctxt = (new wrap_full (no_write_context ~block !rpc_config)) in
+    Alpha_services.Context.next_level ctxt block >>=? fun level ->
+    let seed_nonce_hash =
+      if level.Level.expected_commitment then
+        let seed_nonce =
+          match Nonce.of_bytes @@
+            Rand.generate Constants.nonce_length with
+          | Error _ -> assert false
+          | Ok nonce -> nonce in
+        Some (Nonce.hash seed_nonce)
+      else
+        None in
     let src_sk = Client_keys.Secret_key_locator.create
         ~scheme:"unencrypted"
         ~location:(Ed25519.Secret_key.to_b58check contract.sk) in
     Client_baking_forge.forge_block
-      (new wrap_full (no_write_context ~block !rpc_config))
+      ctxt
       block
       ~operations
       ~force:true
       ~best_effort:false
       ~sort:false
       ~priority:(`Auto (contract.pkh, Some 1024, false))
-      ~seed_nonce_hash
+      ?seed_nonce_hash
       ~src_sk
       ()
 
diff --git a/src/proto_alpha/lib_protocol/src/alpha_context.mli b/src/proto_alpha/lib_protocol/src/alpha_context.mli
index a688f7847..6a782a7cf 100644
--- a/src/proto_alpha/lib_protocol/src/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/src/alpha_context.mli
@@ -307,6 +307,7 @@ module Level : sig
     cycle_position: int32 ;
     voting_period: Voting_period.t ;
     voting_period_position: int32 ;
+    expected_commitment: bool ;
   }
   include BASIC_DATA with type t := t
   val pp_full: Format.formatter -> t -> unit
@@ -653,7 +654,7 @@ module Block_header : sig
 
   and protocol_data = {
     priority: int ;
-    seed_nonce_hash: Nonce_hash.t ;
+    seed_nonce_hash: Nonce_hash.t option ;
     proof_of_work_nonce: MBytes.t ;
   }
 
diff --git a/src/proto_alpha/lib_protocol/src/alpha_services.ml b/src/proto_alpha/lib_protocol/src/alpha_services.ml
index 0fc396ec9..c55a4d81c 100644
--- a/src/proto_alpha/lib_protocol/src/alpha_services.ml
+++ b/src/proto_alpha/lib_protocol/src/alpha_services.ml
@@ -66,7 +66,7 @@ let () =
     Lwt.return (Block_header.parse block_header) >>=? fun block_header ->
     return block_header.protocol_data.priority
   end ;
-  register0_fullctxt S.seed_nonce_hash begin fun { block_header ; _ } () ( )->
+  opt_register0_fullctxt S.seed_nonce_hash begin fun { block_header ; _ } () ( )->
     Lwt.return (Block_header.parse block_header) >>=? fun block_header ->
     return block_header.protocol_data.seed_nonce_hash
   end
diff --git a/src/proto_alpha/lib_protocol/src/apply.ml b/src/proto_alpha/lib_protocol/src/apply.ml
index 83f85119f..3739ed17f 100644
--- a/src/proto_alpha/lib_protocol/src/apply.ml
+++ b/src/proto_alpha/lib_protocol/src/apply.ml
@@ -17,6 +17,7 @@ type error += Duplicate_endorsement of int (* `Branch *)
 type error += Bad_contract_parameter of Contract.t * Script.expr option * Script.expr option (* `Permanent *)
 type error += Too_many_faucet
 type error += Invalid_endorsement_level
+type error += Invalid_commitment of { expected: bool }
 
 
 let () =
@@ -93,7 +94,20 @@ let () =
         Format.fprintf ppf "Unpexpected level in endorsement.")
     Data_encoding.unit
     (function Invalid_endorsement_level -> Some () | _ -> None)
-    (fun () -> Invalid_endorsement_level)
+    (fun () -> Invalid_endorsement_level) ;
+  register_error_kind
+    `Permanent
+    ~id:"block.invalid_commitment"
+    ~title:"Invalid commitment in block header"
+    ~description:"The block header has invalid commitment."
+    ~pp:(fun ppf expected ->
+        if expected then
+          Format.fprintf ppf "Missing seed's nonce commitment in block header."
+        else
+          Format.fprintf ppf "Unexpected seed's nonce commitment in block header.")
+    Data_encoding.(obj1 (req "expected "bool))
+    (function Invalid_commitment { expected } -> Some expected | _ -> None)
+    (fun expected -> Invalid_commitment { expected })
 
 let apply_consensus_operation_content ctxt
     pred_block block_priority operation = function
@@ -352,6 +366,7 @@ let begin_partial_construction ctxt =
   return ctxt
 
 let begin_application ctxt block_header pred_timestamp =
+  let current_level = Alpha_context.Level.current ctxt in
   Baking.check_proof_of_work_stamp ctxt block_header >>=? fun () ->
   Baking.check_fitness_gap ctxt block_header >>=? fun () ->
   Baking.check_baking_rights
@@ -359,6 +374,14 @@ let begin_application ctxt block_header pred_timestamp =
   Baking.check_signature block_header baker >>=? fun () ->
   Baking.pay_baking_bond ctxt block_header.protocol_data
     (Ed25519.Public_key.hash baker) >>=? fun ctxt ->
+  let has_commitment =
+    match block_header.protocol_data.seed_nonce_hash with
+    | None -> false
+    | Some _ -> true in
+  fail_unless
+    Compare.Bool.(has_commitment = current_level.expected_commitment)
+    (Invalid_commitment
+       { expected = current_level.expected_commitment }) >>=? fun () ->
   let ctxt = Fitness.increase ctxt in
   return (ctxt, baker)
 
@@ -366,8 +389,11 @@ let finalize_application ctxt block_protocol_data baker =
   (* end of level (from this point nothing should fail) *)
   let priority = block_protocol_data.Block_header.priority in
   let reward = Baking.base_baking_reward ctxt ~priority in
-  Nonce.record_hash ctxt
-    baker reward block_protocol_data.seed_nonce_hash >>=? fun ctxt ->
+  begin
+    match block_protocol_data.seed_nonce_hash with
+    | None -> return ctxt
+    | Some nonce -> Nonce.record_hash ctxt baker reward nonce
+  end >>=? fun ctxt ->
   Reward.pay_due_rewards ctxt >>=? fun ctxt ->
   (* end of cycle *)
   may_start_new_cycle ctxt >>=? fun ctxt ->
diff --git a/src/proto_alpha/lib_protocol/src/block_header_repr.ml b/src/proto_alpha/lib_protocol/src/block_header_repr.ml
index 9fd301408..2b81dd508 100644
--- a/src/proto_alpha/lib_protocol/src/block_header_repr.ml
+++ b/src/proto_alpha/lib_protocol/src/block_header_repr.ml
@@ -18,7 +18,7 @@ type t = {
 
 and protocol_data = {
   priority: int ;
-  seed_nonce_hash: Nonce_hash.t ;
+  seed_nonce_hash: Nonce_hash.t option ;
   proof_of_work_nonce: MBytes.t ;
 }
 
@@ -34,14 +34,14 @@ let protocol_data_encoding =
   let open Data_encoding in
   conv
     (fun { priority ; seed_nonce_hash ; proof_of_work_nonce } ->
-       (priority, seed_nonce_hash, proof_of_work_nonce))
-    (fun (priority, seed_nonce_hash, proof_of_work_nonce) ->
+       (priority, proof_of_work_nonce, seed_nonce_hash))
+    (fun (priority, proof_of_work_nonce, seed_nonce_hash) ->
        { priority ; seed_nonce_hash ; proof_of_work_nonce })
     (obj3
        (req "priority" uint16)
-       (req "seed_nonce_hash" Nonce_hash.encoding)
        (req "proof_of_work_nonce"
-          (Fixed.bytes Constants_repr.proof_of_work_nonce_size)))
+          (Fixed.bytes Constants_repr.proof_of_work_nonce_size))
+       (opt "seed_nonce_hash" Nonce_hash.encoding))
 
 let signed_protocol_data_encoding =
   let open Data_encoding in
@@ -69,9 +69,13 @@ let encoding =
 (** Constants *)
 
 let max_header_length =
-  match Data_encoding.classify signed_protocol_data_encoding with
-  | `Fixed n -> n
-  | `Dynamic | `Variable -> assert false
+  let fake = { priority = 0 ;
+               proof_of_work_nonce =
+                 MBytes.create Constants_repr.proof_of_work_nonce_size ;
+               seed_nonce_hash = Some Nonce_hash.zero } in
+  let signature = Ed25519.Signature.zero in
+  Data_encoding.Binary.length signed_protocol_data_encoding (fake, signature)
+
 
 (** Header parsing entry point  *)
 
diff --git a/src/proto_alpha/lib_protocol/src/block_header_repr.mli b/src/proto_alpha/lib_protocol/src/block_header_repr.mli
index 3b81c8bae..370235f62 100644
--- a/src/proto_alpha/lib_protocol/src/block_header_repr.mli
+++ b/src/proto_alpha/lib_protocol/src/block_header_repr.mli
@@ -16,7 +16,7 @@ type t = {
 
 and protocol_data = {
   priority: int ;
-  seed_nonce_hash: Nonce_hash.t ;
+  seed_nonce_hash: Nonce_hash.t option ;
   proof_of_work_nonce: MBytes.t ;
 }
 
diff --git a/src/proto_alpha/lib_protocol/src/helpers_services.ml b/src/proto_alpha/lib_protocol/src/helpers_services.ml
index 7a42f6b74..edd9cb1f1 100644
--- a/src/proto_alpha/lib_protocol/src/helpers_services.ml
+++ b/src/proto_alpha/lib_protocol/src/helpers_services.ml
@@ -280,7 +280,7 @@ module Forge = struct
         ~input:
           (obj3
              (req "priority" uint16)
-             (req "nonce_hash" Nonce_hash.encoding)
+             (opt "nonce_hash" Nonce_hash.encoding)
              (dft "proof_of_work_nonce"
                 (Fixed.bytes
                    Alpha_context.Constants.proof_of_work_nonce_size)
@@ -425,8 +425,9 @@ module Forge = struct
 
   let protocol_data ctxt
       block
-      ~priority ~seed_nonce_hash
-      ?(proof_of_work_nonce = empty_proof_of_work_nonce) () =
+      ~priority ?seed_nonce_hash
+      ?(proof_of_work_nonce = empty_proof_of_work_nonce)
+      () =
     RPC_context.make_call0 S.protocol_data
       ctxt block () (priority, seed_nonce_hash, proof_of_work_nonce)
 
diff --git a/src/proto_alpha/lib_protocol/src/helpers_services.mli b/src/proto_alpha/lib_protocol/src/helpers_services.mli
index 99e44c2f8..a4f08553f 100644
--- a/src/proto_alpha/lib_protocol/src/helpers_services.mli
+++ b/src/proto_alpha/lib_protocol/src/helpers_services.mli
@@ -195,7 +195,7 @@ module Forge : sig
   val protocol_data:
     'a #RPC_context.simple -> 'a ->
     priority: int ->
-    seed_nonce_hash: Nonce_hash.t ->
+    ?seed_nonce_hash: Nonce_hash.t ->
     ?proof_of_work_nonce: MBytes.t ->
     unit -> MBytes.t shell_tzresult Lwt.t
 
diff --git a/src/proto_alpha/lib_protocol/src/level_repr.ml b/src/proto_alpha/lib_protocol/src/level_repr.ml
index cac26deb9..4a547d6eb 100644
--- a/src/proto_alpha/lib_protocol/src/level_repr.ml
+++ b/src/proto_alpha/lib_protocol/src/level_repr.ml
@@ -14,6 +14,7 @@ type t = {
   cycle_position: int32 ;
   voting_period: Voting_period_repr.t ;
   voting_period_position: int32 ;
+  expected_commitment: bool ;
 }
 
 include Compare.Make(struct
@@ -37,23 +38,28 @@ let encoding =
   conv
     (fun { level ; level_position ;
            cycle ; cycle_position ;
-           voting_period; voting_period_position } ->
+           voting_period; voting_period_position ;
+           expected_commitment } ->
       (level, level_position,
        cycle, cycle_position,
-       voting_period, voting_period_position))
+       voting_period, voting_period_position,
+       expected_commitment))
     (fun (level, level_position,
           cycle, cycle_position,
-          voting_period, voting_period_position) ->
+          voting_period, voting_period_position,
+          expected_commitment) ->
       { level ; level_position ;
         cycle ; cycle_position ;
-        voting_period ; voting_period_position })
-    (obj6
+        voting_period ; voting_period_position ;
+        expected_commitment })
+    (obj7
        (req "level" Raw_level_repr.encoding)
        (req "level_position" int32)
        (req "cycle" Cycle_repr.encoding)
        (req "cycle_position" int32)
        (req "voting_period" Voting_period_repr.encoding)
-       (req "voting_period_position" int32))
+       (req "voting_period_position" int32)
+       (req "expected_commitment" bool))
 
 let root first_level =
   { level = first_level ;
@@ -62,9 +68,13 @@ let root first_level =
     cycle_position = 0l ;
     voting_period = Voting_period_repr.root ;
     voting_period_position = 0l ;
+    expected_commitment = false ;
   }
 
-let from_raw ~first_level ~cycle_length ~voting_period_length level =
+let from_raw
+    ~first_level ~cycle_length ~voting_period_length
+    ~blocks_per_commitment
+    level =
   let raw_level = Raw_level_repr.to_int32 level in
   let first_level = Raw_level_repr.to_int32 first_level in
   let level_position =
@@ -77,10 +87,13 @@ let from_raw ~first_level ~cycle_length ~voting_period_length level =
       (Int32.div level_position voting_period_length) in
   let voting_period_position =
     Int32.rem level_position voting_period_length in
+  let pos = Int32.rem cycle_position blocks_per_commitment in
+  let expected_commitment = Compare.Int32.(pos = 0l) in
   { level ; level_position ;
     cycle ; cycle_position ;
-    voting_period ; voting_period_position }
+    voting_period ; voting_period_position ;
+    expected_commitment }
 
-let diff { level = l1 } { level = l2 } =
+let diff { level = l1 ; _ } { level = l2 ; _ } =
   Int32.sub (Raw_level_repr.to_int32 l1) (Raw_level_repr.to_int32 l2)
 
diff --git a/src/proto_alpha/lib_protocol/src/level_repr.mli b/src/proto_alpha/lib_protocol/src/level_repr.mli
index 203200a2c..01dee8a04 100644
--- a/src/proto_alpha/lib_protocol/src/level_repr.mli
+++ b/src/proto_alpha/lib_protocol/src/level_repr.mli
@@ -14,6 +14,7 @@ type t = private {
   cycle_position: int32 ;
   voting_period: Voting_period_repr.t ;
   voting_period_position: int32 ;
+  expected_commitment: bool ;
 }
 
 type level = t
@@ -30,6 +31,7 @@ val from_raw:
   first_level:Raw_level_repr.t ->
   cycle_length:int32 ->
   voting_period_length:int32 ->
+  blocks_per_commitment:int32 ->
   Raw_level_repr.t -> level
 
 val diff: level -> level -> int32
diff --git a/src/proto_alpha/lib_protocol/src/level_storage.ml b/src/proto_alpha/lib_protocol/src/level_storage.ml
index e25258b71..c8cbf682d 100644
--- a/src/proto_alpha/lib_protocol/src/level_storage.ml
+++ b/src/proto_alpha/lib_protocol/src/level_storage.ml
@@ -20,6 +20,7 @@ let from_raw c ?offset l =
     ~first_level
     ~cycle_length:constants.Constants_repr.cycle_length
     ~voting_period_length:constants.Constants_repr.voting_period_length
+    ~blocks_per_commitment:constants.Constants_repr.blocks_per_commitment
     l
 
 let root c =
@@ -63,3 +64,16 @@ let levels_in_cycle ctxt c =
     else acc
   in
   loop first []
+
+let levels_with_commitments_in_cycle ctxt c =
+  let first = first_level_in_cycle ctxt c in
+  let rec loop n acc =
+    if Cycle_repr.(n.cycle = first.cycle)
+    then
+      if n.expected_commitment then
+        loop (succ ctxt n) (n :: acc)
+      else
+        loop (succ ctxt n) acc
+    else acc
+  in
+  loop first []
diff --git a/src/proto_alpha/lib_protocol/src/level_storage.mli b/src/proto_alpha/lib_protocol/src/level_storage.mli
index 4a9a9db6d..20321fbb5 100644
--- a/src/proto_alpha/lib_protocol/src/level_storage.mli
+++ b/src/proto_alpha/lib_protocol/src/level_storage.mli
@@ -18,3 +18,6 @@ val succ: Raw_context.t -> Level_repr.t -> Level_repr.t
 
 val last_level_in_cycle: Raw_context.t -> Cycle_repr.t -> Level_repr.t
 val levels_in_cycle: Raw_context.t -> Cycle_repr.t -> Level_repr.t list
+
+val levels_with_commitments_in_cycle:
+  Raw_context.t -> Cycle_repr.t -> Level_repr.t list
diff --git a/src/proto_alpha/lib_protocol/src/raw_context.ml b/src/proto_alpha/lib_protocol/src/raw_context.ml
index e7dae6c4e..f93a1de57 100644
--- a/src/proto_alpha/lib_protocol/src/raw_context.ml
+++ b/src/proto_alpha/lib_protocol/src/raw_context.ml
@@ -236,6 +236,7 @@ let prepare ~level ~timestamp ~fitness ctxt =
       ~first_level
       ~cycle_length:constants.Constants_repr.cycle_length
       ~voting_period_length:constants.Constants_repr.voting_period_length
+      ~blocks_per_commitment:constants.Constants_repr.blocks_per_commitment
       level in
   return ({ context = ctxt ; constants ; level ;
             timestamp ; fitness ; first_level ; roll_value ;
@@ -251,9 +252,9 @@ let rec double_roll_value ctxt i =
     set_roll_value ctxt.context roll_value >>=? fun context ->
     double_roll_value { ctxt with context ; roll_value } (i-1)
 
-let activate ({ context = c } as s) h =
+let activate ({ context = c ; _ } as s) h =
   Updater.activate c h >>= fun c -> Lwt.return { s with context = c }
-let fork_test_chain ({ context = c } as s) protocol expiration =
+let fork_test_chain ({ context = c ; _ } as s) protocol expiration =
   Updater.fork_test_chain c ~protocol ~expiration >>= fun c ->
   Lwt.return { s with context = c }
 
diff --git a/src/proto_alpha/lib_protocol/src/seed_storage.ml b/src/proto_alpha/lib_protocol/src/seed_storage.ml
index 573bfd997..ec3daaf63 100644
--- a/src/proto_alpha/lib_protocol/src/seed_storage.ml
+++ b/src/proto_alpha/lib_protocol/src/seed_storage.ml
@@ -46,7 +46,7 @@ let compute_for_cycle c ~revealed cycle =
   match Cycle_repr.pred cycle with
   | None -> assert false (* should not happen *)
   | Some previous_cycle ->
-      let levels = Level_storage.levels_in_cycle c revealed in
+      let levels = Level_storage.levels_with_commitments_in_cycle c revealed in
       let combine (c, random_seed) level =
         Storage.Seed.Nonce.get c level >>=? function
         | Revealed nonce ->
diff --git a/src/proto_alpha/lib_protocol/src/services_registration.ml b/src/proto_alpha/lib_protocol/src/services_registration.ml
index 243ae404e..15ecfe160 100644
--- a/src/proto_alpha/lib_protocol/src/services_registration.ml
+++ b/src/proto_alpha/lib_protocol/src/services_registration.ml
@@ -34,6 +34,12 @@ let register0_fullctxt s f =
       (fun ctxt q i ->
          rpc_init ctxt >>=? fun ctxt ->
          f ctxt q i)
+let opt_register0_fullctxt s f =
+  rpc_services :=
+    RPC_directory.opt_register !rpc_services s
+      (fun ctxt q i ->
+         rpc_init ctxt >>=? fun ctxt ->
+         f ctxt q i)
 let register0 s f =
   register0_fullctxt s (fun { context ; _ } -> f context)
 let register0_noctxt s f =
diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_block.ml b/src/proto_alpha/lib_protocol/test/helpers/helpers_block.ml
index 075574aaa..275c41f98 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/helpers_block.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/helpers_block.ml
@@ -40,10 +40,14 @@ let get_op_header_res (res : result) : operation_header = {
   branch = res.hash
 }
 
-let get_protocol_data priority : protocol_data = {
+let get_protocol_data priority commit : protocol_data = {
   priority ;
   proof_of_work_nonce = Helpers_crypto.generate_proof_of_work_nonce ();
-  seed_nonce_hash = Proto_alpha.Alpha_context.Nonce.hash @@ Helpers_crypto.generate_seed_nonce ()
+  seed_nonce_hash =
+    if commit then
+      Some (Proto_alpha.Alpha_context.Nonce.hash @@ Helpers_crypto.generate_seed_nonce ())
+    else
+      None
 }
 
 let get_op_header pbh : operation_header = {
@@ -62,7 +66,7 @@ let init (pred_shell_header : shell_header) pred_block_hash
     get_op_header pred_block_hash in
   Helpers_assert.tmp_map (make_sourced_operation op_header) src_protops >>? fun src_ops_hashs ->
   let (sourced_operations, operation_hashs) = List.split src_ops_hashs in
-  let protocol_data = get_protocol_data priority in
+  let protocol_data = get_protocol_data priority true in
   let protocol_data_bytes =
     Proto_alpha.Alpha_context.Block_header.forge_unsigned_protocol_data
       protocol_data
diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_block.mli b/src/proto_alpha/lib_protocol/test/helpers/helpers_block.mli
index 5984b693e..b3d8a4948 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/helpers_block.mli
+++ b/src/proto_alpha/lib_protocol/test/helpers/helpers_block.mli
@@ -40,7 +40,7 @@ type result = {
   tezos_context : Alpha_context.t;
 }
 val get_op_header_res : result -> operation_header
-val get_protocol_data : int -> protocol_data
+val get_protocol_data : int -> bool -> protocol_data
 val get_op_header : Block_hash.t -> operation_header
 val make_sourced_operation :
   Operation.shell_header ->
diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_init.ml b/src/proto_alpha/lib_protocol/test/helpers/helpers_init.ml
index dfdfa7224..db8f3bf31 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/helpers_init.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/helpers_init.ml
@@ -38,7 +38,7 @@ let main () =
   let protocol_data =
     Data_encoding.Binary.to_bytes
       Alpha_context.Block_header.protocol_data_encoding
-      (Helpers_block.get_protocol_data 0) in
+      (Helpers_block.get_protocol_data 0 true) in
   let tezos_header = { Block_header.shell = header ; protocol_data } in
   Proto_alpha.Main.begin_construction
     ~predecessor_context: context