Shell: move level in th shell part of block.

src/Makefile

@@ -247,7 +247,7 @@ ${TZCLIENT}: minutils.cmxa utils.cmxa compiler.cmxa node.cmxa \
              ${EMBEDDED_CLIENT_VERSIONS} \
              ${CLIENT_IMPLS:.ml=.cmx}
 	@echo LINK $(notdir $@)
-	@${OCAMLOPT} -linkpkg ${OCAMLFLAGS} -o $@ $^
+	@${OCAMLOPT} -linkall -linkpkg ${OCAMLFLAGS} -o $@ $^
 
 clean::
 	-rm -f ${TZCLIENT}
@@ -413,7 +413,6 @@ client/embedded/client_%.cmx: \
   $(patsubst %.ml, %.cmx, $(NODE_LIB_IMPLS) $(CLIENT_LIB_IMPLS)) \
   proto/client_embedded_proto_%.cmxa \
   $$(shell find client/embedded/% \( -name webclient -or -name _tzbuild \) -prune -or \( -name \*.ml -print -or -name \*.mli -print \))
-	@echo $^
 	@$(MAKE) -C client/embedded/$* ../client_$*.cmx
 
 client/embedded/webclient_%.cmx: \

src/client/client_node_rpcs.ml

@@ -15,9 +15,9 @@ module Services = Node_rpc_services
 let errors cctxt =
   call_service0 cctxt Services.Error.service ()
 
-let forge_block cctxt ?net ?predecessor ?timestamp fitness ops header =
+let forge_block cctxt ?net ?level ?predecessor ?timestamp fitness ops header =
   call_service0 cctxt Services.forge_block
-    (net, predecessor, timestamp, fitness, ops, header)
+    (net, level, predecessor, timestamp, fitness, ops, header)
 
 let validate_block cctxt net block =
   call_err_service0 cctxt Services.validate_block (net, block)
@@ -53,6 +53,7 @@ module Blocks = struct
 
   type block_info = Services.Blocks.block_info = {
     hash: Block_hash.t ;
+    level: Int32.t ;
     predecessor: Block_hash.t ;
     fitness: MBytes.t list ;
     timestamp: Time.t ;
@@ -76,6 +77,8 @@ module Blocks = struct
   }
   let net cctxt h =
     call_service1 cctxt Services.Blocks.net h ()
+  let level cctxt h =
+    call_service1 cctxt Services.Blocks.level h ()
   let predecessor cctxt h =
     call_service1 cctxt Services.Blocks.predecessor h ()
   let predecessors cctxt h l =
@@ -94,6 +97,7 @@ module Blocks = struct
     call_service1 cctxt Services.Blocks.test_protocol h ()
   let test_network cctxt h =
     call_service1 cctxt Services.Blocks.test_network h ()
+
   let preapply cctxt h ?timestamp ?(sort = false) operations =
     call_err_service1
       cctxt Services.Blocks.preapply h

src/client/client_node_rpcs.mli

@@ -15,6 +15,7 @@ val errors:
 val forge_block:
   config ->
   ?net:Net_id.t ->
+  ?level:Int32.t ->
   ?predecessor:Block_hash.t ->
   ?timestamp:Time.t ->
   Fitness.fitness ->
@@ -67,6 +68,9 @@ module Blocks : sig
   val net:
     config ->
     block -> Net_id.t tzresult Lwt.t
+  val level:
+    config ->
+    block -> Int32.t tzresult Lwt.t
   val predecessor:
     config ->
     block -> Block_hash.t tzresult Lwt.t
@@ -102,6 +106,7 @@ module Blocks : sig
 
   type block_info = {
     hash: Block_hash.t ;
+    level: Int32.t ;
     predecessor: Block_hash.t ;
     fitness: MBytes.t list ;
     timestamp: Time.t ;

src/client/embedded/alpha/baker/client_mining_forge.ml

@@ -22,14 +22,14 @@ let generate_seed_nonce () =
   | Ok nonce -> nonce
 
 let rec compute_stamp
-    cctxt block delegate_sk shell mining_slot seed_nonce_hash =
+    cctxt block delegate_sk shell priority seed_nonce_hash =
   Client_proto_rpcs.Constants.stamp_threshold
     cctxt block >>=? fun stamp_threshold ->
   let rec loop () =
     let proof_of_work_nonce = generate_proof_of_work_nonce () in
     let unsigned_header =
       Tezos_context.Block.forge_header
-        shell { mining_slot ; seed_nonce_hash ; proof_of_work_nonce } in
+        shell { priority ; seed_nonce_hash ; proof_of_work_nonce } in
     let signed_header =
       Ed25519.Signature.append delegate_sk unsigned_header in
     let block_hash = Block_hash.hash_bytes [signed_header] in
@@ -51,11 +51,10 @@ let inject_block cctxt block
     Operation_list_list_hash.compute
       (List.map Operation_list_hash.compute operation_list) in
   let shell =
-    { Store.Block_header.net_id = bi.net ; predecessor = bi.hash ;
+    { Store.Block_header.net_id = bi.net ; level = bi.level ;
-      timestamp ; fitness ; operations } in
+      predecessor = bi.hash ; timestamp ; fitness ; operations } in
-  let slot = { Block.level = level.level ; priority } in
   compute_stamp cctxt block
-    src_sk shell slot seed_nonce_hash >>=? fun proof_of_work_nonce ->
+    src_sk shell priority seed_nonce_hash >>=? fun proof_of_work_nonce ->
   Client_proto_rpcs.Helpers.Forge.block cctxt
     block
     ~net:bi.net

src/client/embedded/alpha/client_proto_rpcs.ml

@@ -64,11 +64,7 @@ end
 module Context = struct
 
   let level cctxt block =
-    match block with
+    call_error_service1 cctxt Services.Context.level block ()
-    | `Genesis -> return Level.root
-    | `Hash h when Block_hash.equal Client_blocks.genesis h ->
-        return Level.root
-    | _ -> call_error_service1 cctxt Services.Context.level block ()
 
   let next_level cctxt block =
     call_error_service1 cctxt Services.Context.next_level block ()

src/client/embedded/genesis/client_proto_main.ml

@@ -26,9 +26,10 @@ let call_error_service1 rpc_config s block a1 =
 let forge_block
     rpc_config block net_id ?(timestamp = Time.now ()) command fitness =
   Client_blocks.get_block_hash rpc_config block >>=? fun pred ->
+  Client_node_rpcs.Blocks.level rpc_config block >>=? fun level ->
   call_service1 rpc_config
     Services.Forge.block block
-    ((net_id, pred, timestamp, fitness), command)
+    ((net_id, Int32.succ level, pred, timestamp, fitness), command)
 
 let mine rpc_config ?timestamp block command fitness seckey =
   Client_blocks.get_block_info rpc_config block >>=? fun bi ->

src/node/db/store.ml

@@ -258,6 +258,7 @@ module Block_header = struct
 
   type shell_header = {
     net_id: Net_id.t ;
+    level: Int32.t ;
     predecessor: Block_hash.t ;
     timestamp: Time.t ;
     operations: Operation_list_list_hash.t ;
@@ -267,12 +268,15 @@ module Block_header = struct
   let shell_header_encoding =
     let open Data_encoding in
     conv
-      (fun { net_id ; predecessor ; timestamp ; operations ; fitness } ->
+      (fun { net_id ; level ; predecessor ;
-         (net_id, predecessor, timestamp, operations, fitness))
+             timestamp ; operations ; fitness } ->
-      (fun (net_id, predecessor, timestamp, operations, fitness) ->
+         (net_id, level, predecessor, timestamp, operations, fitness))
-         { net_id ; predecessor ; timestamp ; operations ; fitness })
+      (fun (net_id, level, predecessor, timestamp, operations, fitness) ->
-      (obj5
+         { net_id ; level ; predecessor ;
+           timestamp ; operations ; fitness })
+      (obj6
          (req "net_id" Net_id.encoding)
+         (req "level" int32)
          (req "predecessor" Block_hash.encoding)
          (req "timestamp" Time.encoding)
          (req "operations" Operation_list_list_hash.encoding)

src/node/db/store.mli

@@ -171,6 +171,7 @@ module Block_header : sig
 
   type shell_header = {
     net_id: Net_id.t ;
+    level: Int32.t ;
     predecessor: Block_hash.t ;
     timestamp: Time.t ;
     operations: Operation_list_list_hash.t ;

src/node/shell/node.ml

@@ -138,6 +138,7 @@ module RPC = struct
   type block = Node_rpc_services.Blocks.block
   type block_info = Node_rpc_services.Blocks.block_info = {
     hash: Block_hash.t ;
+    level: Int32.t ;
     predecessor: Block_hash.t ;
     fitness: MBytes.t list ;
     timestamp: Time.t ;
@@ -152,6 +153,7 @@ module RPC = struct
 
   let convert (block: State.Valid_block.t)  = {
     hash = block.hash ;
+    level = block.level ;
     predecessor = block.predecessor ;
     fitness = block.fitness ;
     timestamp = block.timestamp ;
@@ -167,6 +169,7 @@ module RPC = struct
   let convert_block hash ({ shell ; proto }: State.Block_header.t)  = {
     net = shell.net_id ;
     hash = hash ;
+    level = shell.level ;
     predecessor = shell.predecessor ;
     fitness = shell.fitness ;
     timestamp = shell.timestamp ;
@@ -282,16 +285,27 @@ module RPC = struct
             Context.get_protocol context >>= fun protocol ->
             let operations =
               let pv_result, _ = Prevalidator.operations pv in
-              Some [ pv_result.applied ] in
+              [ pv_result.applied ] in
-            let timestamp = Prevalidator.timestamp pv in
             Lwt.return
-              { (convert head) with
+              { hash = prevalidation_hash ;
-                hash = prevalidation_hash ;
+                level = Int32.succ head.level ;
+                predecessor = head.hash ;
+                fitness ;
+                timestamp = Prevalidator.timestamp pv ;
                 protocol = Some protocol ;
-                fitness ; operations ; timestamp }
+                operations_hash =
+                  Operation_list_list_hash.compute
+                    (List.map Operation_list_hash.compute operations) ;
+                operations = Some operations ;
+                data = None ;
+                net = head.net_id ;
+                test_protocol = None ;
+                test_network = None ;
+              }
 
   let rpc_context block : Updater.rpc_context =
     { context = block.State.Valid_block.context ;
+      level = Int32.succ  block.level ;
       fitness = block.fitness ;
       timestamp = block. timestamp }
 
@@ -313,13 +327,16 @@ module RPC = struct
         | Some block -> Some (rpc_context block)
       end
     | ( `Prevalidation | `Test_prevalidation ) as block ->
-        let validator, _net = get_net node block in
+        let validator, net = get_net node block in
         let pv = Validator.prevalidator validator in
         Prevalidator.context pv >>= function
         | Error _ -> Lwt.fail Not_found
         | Ok { context ; fitness } ->
             let timestamp = Prevalidator.timestamp pv in
-            Lwt.return (Some { Updater.context ; fitness ; timestamp })
+            State.Valid_block.Current.head
+              (Distributed_db.state net) >>= fun { level } ->
+            let level = Int32.succ level in
+            Lwt.return (Some { Updater.context ; fitness ; timestamp ; level })
 
   let operations node block =
     match block with

src/node/shell/node_rpc.ml

@@ -37,6 +37,12 @@ let register_bi_dir node dir =
       RPC.Answer.return bi.net in
     RPC.register1 dir
       Services.Blocks.net implementation in
+  let dir =
+    let implementation b () =
+      Node.RPC.block_info node b >>= fun bi ->
+      RPC.Answer.return bi.level in
+    RPC.register1 dir
+      Services.Blocks.level implementation in
   let dir =
     let implementation b () =
       Node.RPC.block_info node b >>= fun bi ->
@@ -404,14 +410,16 @@ let build_rpc_directory node =
   let dir =
     RPC.register1 dir Services.Protocols.contents (get_protocols node) in
   let dir =
-    let implementation (net_id, pred, time, fitness, operations, header) =
+    let implementation (net_id, level, pred, time, fitness, operations, header) =
       Node.RPC.block_info node (`Head 0) >>= fun bi ->
       let timestamp = Utils.unopt ~default:(Time.now ()) time in
       let net_id = Utils.unopt ~default:bi.net net_id in
       let predecessor = Utils.unopt ~default:bi.hash pred in
+      let level = Utils.unopt ~default:(Int32.succ bi.level) level in
       let res =
         Data_encoding.Binary.to_bytes Store.Block_header.encoding {
-          shell = { net_id ; predecessor ; timestamp ; fitness ; operations } ;
+          shell = { net_id ; predecessor ; level ;
+                    timestamp ; fitness ; operations } ;
           proto = header ;
         } in
       RPC.Answer.return res in

src/node/shell/node_rpc_services.ml

@@ -57,6 +57,7 @@ module Blocks = struct
 
   type block_info = {
     hash: Block_hash.t ;
+    level: Int32.t ;
     predecessor: Block_hash.t ;
     fitness: MBytes.t list ;
     timestamp: Time.t ;
@@ -71,21 +72,22 @@ module Blocks = struct
 
   let block_info_encoding =
     conv
-      (fun { hash ; predecessor ; fitness ; timestamp ; protocol ;
+      (fun { hash ; level ; predecessor ; fitness ; timestamp ; protocol ;
              operations_hash ; operations ; data ; net ;
              test_protocol ; test_network } ->
-        ((hash, predecessor, fitness, timestamp, protocol),
+        ((hash, level, predecessor, fitness, timestamp, protocol),
          (operations_hash, operations, data,
           net, test_protocol, test_network)))
-      (fun ((hash, predecessor, fitness, timestamp, protocol),
+      (fun ((hash, level, predecessor, fitness, timestamp, protocol),
             (operations_hash, operations, data,
              net, test_protocol, test_network)) ->
-        { hash ; predecessor ; fitness ; timestamp ; protocol ;
+        { hash ; level ; predecessor ; fitness ; timestamp ; protocol ;
           operations_hash ; operations ; data ; net ;
           test_protocol ; test_network })
       (merge_objs
-        (obj5
+        (obj6
            (req "hash" Block_hash.encoding)
+           (req "level" int32)
            (req "predecessor" Block_hash.encoding)
            (req "fitness" Fitness.encoding)
            (req "timestamp" Time.encoding)
@@ -193,6 +195,13 @@ module Blocks = struct
       ~output: (obj1 (req "net" Net_id.encoding))
       RPC.Path.(block_path / "net")
 
+  let level =
+    RPC.service
+      ~description:"Returns the block's level."
+      ~input: empty
+      ~output: (obj1 (req "level" int32))
+      RPC.Path.(block_path / "level")
+
   let predecessor =
     RPC.service
       ~description:"Returns the previous block's id."
@@ -642,8 +651,9 @@ let forge_block =
   RPC.service
     ~description: "Forge a block header"
     ~input:
-      (obj6
+      (obj7
          (opt "net_id" Net_id.encoding)
+         (opt "level" int32)
          (opt "predecessor" Block_hash.encoding)
          (opt "timestamp" Time.encoding)
          (req "fitness" Fitness.encoding)

src/node/shell/node_rpc_services.mli

@@ -28,6 +28,7 @@ module Blocks : sig
 
   type block_info = {
     hash: Block_hash.t ;
+    level: Int32.t ;
     predecessor: Block_hash.t ;
     fitness: MBytes.t list ;
     timestamp: Time.t ;
@@ -44,6 +45,8 @@ module Blocks : sig
     (unit, unit * block, bool * bool, block_info) RPC.service
   val net:
     (unit, unit * block, unit, Net_id.t) RPC.service
+  val level:
+    (unit, unit * block, unit, Int32.t) RPC.service
   val predecessor:
     (unit, unit * block, unit, Block_hash.t) RPC.service
   val predecessors:
@@ -179,7 +182,7 @@ end
 
 val forge_block:
   (unit, unit,
-   Net_id.t option * Block_hash.t option * Time.t option *
+   Net_id.t option * Int32.t option * Block_hash.t option * Time.t option *
    Fitness.fitness * Operation_list_list_hash.t * MBytes.t,
    MBytes.t) RPC.service
 

src/node/shell/prevalidation.ml

@@ -136,7 +136,8 @@ let start_prevalidation
       hash = predecessor ;
       context = predecessor_context ;
       timestamp = predecessor_timestamp ;
-      fitness = predecessor_fitness }
+      fitness = predecessor_fitness ;
+      level = predecessor_level }
     ~timestamp =
   let (module Proto) =
     match protocol with
@@ -146,6 +147,7 @@ let start_prevalidation
     ~predecessor_context
     ~predecessor_timestamp
     ~predecessor_fitness
+    ~predecessor_level
     ~predecessor
     ~timestamp
   >>=? fun state ->

src/node/shell/state.ml

@@ -110,6 +110,7 @@ and net_state = {
 and valid_block = {
   net_id: Net_id.t ;
   hash: Block_hash.t ;
+  level: Int32.t ;
   predecessor: Block_hash.t ;
   timestamp: Time.t ;
   fitness: Protocol.fitness ;
@@ -144,6 +145,7 @@ let build_valid_block
   let valid_block = {
     net_id = header.Store.Block_header.shell.net_id ;
     hash ;
+    level = header.shell.level ;
     predecessor = header.shell.predecessor ;
     timestamp = header.shell.timestamp ;
     discovery_time ;
@@ -540,6 +542,7 @@ module Raw_block_header = struct
   let store_genesis store genesis =
     let shell : Store.Block_header.shell_header = {
       net_id = Net_id.of_block_hash genesis.block;
+      level = 0l ;
       predecessor = genesis.block ;
       timestamp = genesis.time ;
       fitness = [] ;
@@ -553,22 +556,23 @@ module Raw_block_header = struct
     Raw_operation_list.Locked.store_all store genesis.block [] [] >>= fun () ->
     Lwt.return header
 
-  let store_testnet_genesis store genesis =
+  (* let store_testnet_genesis store genesis = *)
-    let shell : Store.Block_header.shell_header = {
+    (* let shell : Store.Block_header.shell_header = { *)
-      net_id = Net_id.of_block_hash genesis.block;
+      (* net_id = Net_id.of_block_hash genesis.block; *)
-      predecessor = genesis.block ;
+      (* level = 0l ; *)
-      timestamp = genesis.time ;
+      (* predecessor = genesis.block ; *)
-      fitness = [] ;
+      (* timestamp = genesis.time ; *)
-      operations = Operation_list_list_hash.empty ;
+      (* fitness = [] ; *)
-    } in
+      (* operations = Operation_list_list_hash.empty ; *)
-    let bytes =
+    (* } in *)
-      Data_encoding.Binary.to_bytes Store.Block_header.encoding {
+    (* let bytes = *)
-        shell ;
+      (* Data_encoding.Binary.to_bytes Store.Block_header.encoding { *)
-        proto = MBytes.create 0 ;
+        (* shell ; *)
-      } in
+        (* proto = MBytes.create 0 ; *)
-    Locked.store_raw store genesis.block bytes >>= fun _created ->
+      (* } in *)
-    Raw_operation_list.Locked.store_all store genesis.block [] [] >>= fun () ->
+    (* Locked.store_raw store genesis.block bytes >>= fun _created -> *)
-    Lwt.return shell
+    (* Raw_operation_list.Locked.store_all store genesis.block [] [] >>= fun () -> *)
+    (* Lwt.return shell *)
 
 end
 
@@ -693,6 +697,7 @@ module Block_header = struct
 
   type shell_header = Store.Block_header.shell_header = {
     net_id: Net_id.t ;
+    level: Int32.t ;
     predecessor: Block_hash.t ;
     timestamp: Time.t ;
     operations: Operation_list_list_hash.t ;
@@ -932,6 +937,7 @@ module Valid_block = struct
   type t = valid_block = {
     net_id: Net_id.t ;
     hash: Block_hash.t ;
+    level: Int32.t ;
     predecessor: Block_hash.t ;
     timestamp: Time.t ;
     fitness: Fitness.fitness ;
@@ -996,7 +1002,7 @@ module Valid_block = struct
         block_header_store
         (net_state: net_state)
         valid_block_watcher
-        hash { Updater.context ; fitness ; message } ttl =
+        hash { Updater.context ; message ; fitness } ttl =
       (* Read the block header. *)
       Raw_block_header.Locked.read
         block_header_store hash >>=? fun block ->
@@ -1044,11 +1050,11 @@ module Valid_block = struct
         match message with
         | Some message -> message
         | None ->
-            Format.asprintf "%a: %a"
+            Format.asprintf "%a(%ld): %a"
               Block_hash.pp_short hash
+              block.shell.level
               Fitness.pp fitness in
-      Context.commit
+      Context.commit hash block.shell.timestamp message context >>= fun () ->
-        hash ~time:block.shell.timestamp ~message context >>= fun () ->
       (* Update the chain state. *)
       let store = net_state.chain_store in
       let predecessor = block.shell.predecessor in
@@ -1083,7 +1089,7 @@ module Valid_block = struct
     | Error _ -> Lwt.fail Not_found
     | Ok b -> Lwt.return b
 
-  let store net hash context =
+  let store net hash vcontext =
     Shared.use net.state begin fun net_state ->
       Shared.use net.block_header_store begin fun block_header_store ->
         Context.exists net_state.context_index hash >>= function
@@ -1095,7 +1101,8 @@ module Valid_block = struct
             | None ->
                 Locked.store
                   block_header_store net_state net.valid_block_watcher
-                  hash context net.forked_network_ttl >>=? fun valid_block ->
+                  hash vcontext
+                  net.forked_network_ttl >>=? fun valid_block ->
                 return (Some valid_block)
       end
     end

src/node/shell/state.mli

@@ -144,6 +144,7 @@ module Block_header : sig
 
   type shell_header = Store.Block_header.shell_header = {
     net_id: Net_id.t ;
+    level: Int32.t ;
     predecessor: Block_hash.t ;
     timestamp: Time.t ;
     operations: Operation_list_list_hash.t ;
@@ -245,6 +246,8 @@ module Valid_block : sig
     (** The genesis of the chain this block belongs to. *)
     hash: Block_hash.t ;
     (** The block hash. *)
+    level: Int32.t ;
+    (** The number of preceding block in the chain. *)
     predecessor: Block_hash.t ;
     (** The preceding block in the chain. *)
     timestamp: Time.t ;

src/node/shell/validator.ml

@@ -142,6 +142,22 @@ type error +=
    | Invalid_operation of Operation_hash.t
    | Non_increasing_timestamp
    | Non_increasing_fitness
+   | Wrong_level of Int32.t * Int32.t
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"validator.wrong_level"
+    ~title:"Wrong level"
+    ~description:"The block level is not the expected one"
+    ~pp:(fun ppf (e, g) ->
+        Format.fprintf ppf
+          "The declared level %ld is not %ld" g e)
+    Data_encoding.(obj2
+                     (req "expected" int32)
+                     (req "provided" int32))
+    (function Wrong_level (e, g)   -> Some (e, g) | _ -> None)
+    (fun (e, g) -> Wrong_level (e, g))
 
 let apply_block net db
     (pred: State.Valid_block.t) hash (block: State.Block_header.t) =
@@ -151,6 +167,9 @@ let apply_block net db
     Block_hash.pp_short block.shell.predecessor
     Net_id.pp id
   >>= fun () ->
+  fail_unless
+    (Int32.succ pred.level = block.shell.level)
+    (Wrong_level (Int32.succ pred.level, block.shell.level)) >>=? fun () ->
   lwt_log_info "validation of %a: looking for dependencies..."
     Block_hash.pp_short hash >>= fun () ->
   Distributed_db.Operation_list.fetch

src/node/updater/protocol.mli

@@ -24,6 +24,7 @@ type raw_operation = Store.Operation.t = {
 
 type shell_block = Store.Block_header.shell_header =
   { net_id: Net_id.t ;
+    level: Int32.t ;
     predecessor: Block_hash.t ;
     timestamp: Time.t ;
     operations: Operation_list_list_hash.t ;
@@ -43,6 +44,7 @@ type validation_result = {
 
 type rpc_context = {
   context: Context.t ;
+  level: Int32.t ;
   timestamp: Time.t ;
   fitness: Fitness.fitness ;
 }
@@ -78,6 +80,7 @@ module type PROTOCOL = sig
   val begin_construction :
     predecessor_context: Context.t ->
     predecessor_timestamp: Time.t ->
+    predecessor_level: Int32.t ->
     predecessor_fitness: Fitness.fitness ->
     predecessor: Block_hash.t ->
     timestamp: Time.t ->

src/node/updater/register.ml

@@ -49,11 +49,11 @@ let register (module Proto : Protocol.PACKED_PROTOCOL) =
         raw_block >|= wrap_error
     let begin_construction
         ~predecessor_context ~predecessor_timestamp
-        ~predecessor_fitness
+        ~predecessor_level ~predecessor_fitness
         ~predecessor ~timestamp =
       begin_construction
         ~predecessor_context ~predecessor_timestamp
-        ~predecessor_fitness
+        ~predecessor_level ~predecessor_fitness
         ~predecessor ~timestamp >|= wrap_error
     let current_context c =
       current_context c >|= wrap_error

src/node/updater/updater.ml

@@ -19,6 +19,7 @@ type validation_result = Protocol.validation_result = {
 
 type rpc_context = Protocol.rpc_context = {
   context: Context.t ;
+  level: Int32.t ;
   timestamp: Time.t ;
   fitness: Fitness.fitness ;
 }
@@ -44,6 +45,7 @@ let raw_operation_encoding = Store.Operation.encoding
 
 type shell_block = Store.Block_header.shell_header = {
   net_id: Net_id.t ;
+  level: Int32.t ;
   predecessor: Block_hash.t ;
   timestamp: Time.t ;
   operations: Operation_list_list_hash.t ;

src/node/updater/updater.mli

@@ -20,6 +20,7 @@ val raw_operation_encoding: raw_operation Data_encoding.t
 
 type shell_block = Store.Block_header.shell_header = {
   net_id: Net_id.t ;
+  level: Int32.t ;
   predecessor: Block_hash.t ;
   timestamp: Time.t ;
   operations: Operation_list_list_hash.t ;
@@ -41,6 +42,7 @@ type validation_result = Protocol.validation_result = {
 
 type rpc_context = Protocol.rpc_context = {
   context: Context.t ;
+  level: Int32.t ;
   timestamp: Time.t ;
   fitness: Fitness.fitness ;
 }

src/proto/alpha/amendment.ml

@@ -133,12 +133,13 @@ let record_ballot ctxt delegate proposal ballot =
   | Testing | Proposal ->
       fail Unexpected_ballot
 
-let first_of_a_voting_period l =
+let last_of_a_voting_period ctxt l =
-  Compare.Int32.(l.Level.voting_period_position = 0l)
+  Compare.Int32.(Int32.succ l.Level.voting_period_position =
+                 Constants.voting_period_length ctxt )
 
 let may_start_new_voting_cycle ctxt =
-  Level.current ctxt >>=? fun level ->
+  let level = Level.current ctxt in
-  if first_of_a_voting_period level then
+  if last_of_a_voting_period ctxt level then
     start_new_voting_cycle ctxt
   else
     return ctxt

src/proto/alpha/apply.ml

@@ -54,16 +54,16 @@ let apply_delegate_operation_content
       let ctxt = Fitness.increase ctxt in
       Mining.pay_endorsement_bond ctxt delegate >>=? fun (ctxt, bond) ->
       Mining.endorsement_reward ~block_priority >>=? fun reward ->
-      Level.current ctxt >>=? fun { cycle = current_cycle } ->
+      let { cycle = current_cycle } : Level.t = Level.current ctxt in
       Lwt.return Tez.(reward +? bond) >>=? fun full_reward ->
       Reward.record ctxt delegate current_cycle full_reward
   | Proposals { period ; proposals } ->
-      Level.current ctxt >>=? fun level ->
+      let level = Level.current ctxt in
       fail_unless Voting_period.(level.voting_period = period)
         (Wrong_voting_period (level.voting_period, period)) >>=? fun () ->
       Amendment.record_proposals ctxt delegate proposals
   | Ballot { period ; proposal ; ballot } ->
-      Level.current ctxt >>=? fun level ->
+      let level = Level.current ctxt in
       fail_unless Voting_period.(level.voting_period = period)
         (Wrong_voting_period (level.voting_period, period)) >>=? fun () ->
       Amendment.record_ballot ctxt delegate proposal ballot
@@ -228,11 +228,8 @@ let apply_operation
 let may_start_new_cycle ctxt =
   Mining.dawn_of_a_new_cycle ctxt >>=? function
   | None -> return ctxt
-  | Some new_cycle ->
+  | Some last_cycle ->
-      let last_cycle =
+      let new_cycle = Cycle.succ last_cycle in
-        match Cycle.pred new_cycle with
-        | None -> assert false
-        | Some last_cycle -> last_cycle in
       Bootstrap.refill ctxt >>=? fun ctxt ->
       Seed.clear_cycle ctxt last_cycle >>=? fun ctxt ->
       Seed.compute_for_cycle ctxt (Cycle.succ new_cycle) >>=? fun ctxt ->
@@ -259,12 +256,11 @@ let begin_application ctxt block pred_timestamp =
 
 let finalize_application ctxt block miner =
   (* end of level (from this point nothing should fail) *)
-  let priority = block.Block.proto.mining_slot.priority in
+  let priority = block.Block.proto.priority in
   let reward = Mining.base_mining_reward ctxt ~priority in
   Nonce.record_hash ctxt
     miner reward block.proto.seed_nonce_hash >>=? fun ctxt ->
   Reward.pay_due_rewards ctxt >>=? fun ctxt ->
-  Level.increment_current ctxt >>=? fun ctxt ->
   (* end of cycle *)
   may_start_new_cycle ctxt >>=? fun ctxt ->
   Amendment.may_start_new_voting_cycle ctxt >>=? fun ctxt ->

src/proto/alpha/block_repr.ml

@@ -19,37 +19,23 @@ type header = {
 }
 
 and proto_header = {
-  mining_slot: mining_slot ;
+  priority: int ;
   seed_nonce_hash: Nonce_hash.t ;
   proof_of_work_nonce: MBytes.t ;
 }
 
-and mining_slot = {
-  level: Raw_level_repr.t ;
-  priority: int ;
-}
-
-let mining_slot_encoding =
-  let open Data_encoding in
-  conv
-    (fun { level ; priority } -> level, priority)
-    (fun (level, priority) -> { level ; priority })
-    (obj2
-       (req "level" Raw_level_repr.encoding)
-       (req "priority" uint16))
-
 let proto_header_encoding =
   let open Data_encoding in
   conv
-    (fun { mining_slot ; seed_nonce_hash ; proof_of_work_nonce } ->
+    (fun { priority ; seed_nonce_hash ; proof_of_work_nonce } ->
-       (mining_slot, (seed_nonce_hash, proof_of_work_nonce)))
+       (priority, seed_nonce_hash, proof_of_work_nonce))
-    (fun (mining_slot, (seed_nonce_hash, proof_of_work_nonce)) ->
+    (fun (priority, seed_nonce_hash, proof_of_work_nonce) ->
-       { mining_slot ; seed_nonce_hash ; proof_of_work_nonce })
+       { priority ; seed_nonce_hash ; proof_of_work_nonce })
-    (merge_objs
+    (obj3
-       mining_slot_encoding
+      (req "priority" uint16)
-       (obj2
+      (req "seed_nonce_hash" Nonce_hash.encoding)
-          (req "seed_nonce_hash" Nonce_hash.encoding)
+      (req "proof_of_work_nonce"
-          (req "proof_of_work_nonce" (Fixed.bytes Constants_repr.proof_of_work_nonce_size))))
+         (Fixed.bytes Constants_repr.proof_of_work_nonce_size)))
 
 let signed_proto_header_encoding =
   let open Data_encoding in
@@ -76,13 +62,15 @@ type error +=
   | Cant_parse_proto_header
 
 let parse_header
-    ({ shell = { net_id ; predecessor ; timestamp ; fitness ; operations } ;
+    ({ shell = { net_id ; level ; predecessor ;
+                 timestamp ; fitness ; operations } ;
        proto } : Updater.raw_block) : header tzresult =
   match Data_encoding.Binary.of_bytes signed_proto_header_encoding proto with
   | None -> Error [Cant_parse_proto_header]
   | Some (proto, signature) ->
       let shell =
-        { Updater.net_id ; predecessor ; timestamp ; fitness ; operations } in
+        { Updater.net_id ; level ; predecessor ;
+          timestamp ; fitness ; operations } in
       Ok { shell ; proto ; signature }
 
 let forge_header shell proto =

src/proto/alpha/block_repr.mli

@@ -17,18 +17,11 @@ type header = {
 }
 
 and proto_header = {
-  mining_slot: mining_slot ;
+  priority: int ;
   seed_nonce_hash: Nonce_hash.t ;
   proof_of_work_nonce: MBytes.t ;
 }
 
-and mining_slot = {
-  level: Raw_level_repr.t ;
-  priority: int ;
-}
-
-val mining_slot_encoding: mining_slot Data_encoding.encoding
-
 (** The maximum size of block headers in bytes *)
 val max_header_length: int
 

src/proto/alpha/init_storage.ml

@@ -7,19 +7,9 @@
 (*                                                                        *)
 (**************************************************************************)
 
-let version_key = ["version"]
-
-(* This key should always be populated for every version of the
-   protocol.  It's absence meaning that the context is empty. *)
-let version_value = "alpha"
-
 (* This is the genesis protocol: initialise the state *)
-let initialize ~timestamp ~fitness (ctxt: Context.t) =
+let initialize store =
-  Context.set ctxt version_key (MBytes.of_string version_value) >>= fun ctxt ->
-  Storage.prepare ~timestamp ~fitness ctxt >>=? fun store ->
-  Level_storage.init store >>=? fun store ->
   Roll_storage.init store >>=? fun store ->
-  Nonce_storage.init store >>=? fun store ->
   Seed_storage.init store >>=? fun store ->
   Contract_storage.init store >>=? fun store ->
   Reward_storage.init store >>=? fun store ->
@@ -32,34 +22,25 @@ let initialize ~timestamp ~fitness (ctxt: Context.t) =
   return store
 
 type error +=
-  | Incompatiple_protocol_version
   | Unimplemented_sandbox_migration
 
-let may_initialize ctxt ~timestamp ~fitness =
+let may_initialize ctxt ~level ~timestamp ~fitness =
-  Context.get ctxt version_key >>= function
+  Storage.prepare ~level ~timestamp ~fitness ctxt >>=? fun (ctxt, first_block) ->
-  | None ->
+  if first_block then
-      (* This is the genesis protocol: The only acceptable preceding
+    initialize ctxt
-         version is an empty context *)
+  else
-      initialize ~timestamp ~fitness ctxt
+    return ctxt
-  | Some bytes ->
-      let s = MBytes.to_string bytes in
-      if Compare.String.(s = version_value) then
-        Storage.prepare ~timestamp ~fitness ctxt
-      else if Compare.String.(s = "genesis") then
-        initialize ~timestamp ~fitness ctxt
-      else
-        fail Incompatiple_protocol_version
 
 let configure_sandbox ctxt json =
   let json =
     match json with
     | None -> `O []
     | Some json -> json in
-  Context.get ctxt version_key >>= function
+  Storage.is_first_block ctxt >>=? function
-  | None ->
+  | true ->
       Storage.set_sandboxed ctxt json >>= fun ctxt ->
       return ctxt
-  | Some _ ->
+  | false ->
       Storage.get_sandboxed ctxt >>=? function
       | None ->
           fail Unimplemented_sandbox_migration

src/proto/alpha/level_repr.ml

@@ -10,6 +10,7 @@
 
 type t = {
   level: Raw_level_repr.t ;
+  level_position: int32 ;
   cycle: Cycle_repr.t ;
   cycle_position: int32 ;
   voting_period: Voting_period_repr.t ;
@@ -22,47 +23,58 @@ let pp ppf { level } = Raw_level_repr.pp ppf level
 
 let pp_full ppf l =
   Format.fprintf ppf
-    "%a (cycle %a.%ld) (vote %a.%ld)"
+    "%a.%ld (cycle %a.%ld) (vote %a.%ld)"
-    Raw_level_repr.pp l.level
+    Raw_level_repr.pp l.level l.level_position
     Cycle_repr.pp l.cycle l.cycle_position
     Voting_period_repr.pp l.voting_period l.voting_period_position
 
 let encoding =
   let open Data_encoding in
   conv
-    (fun { level ; cycle ; cycle_position ;
+    (fun { level ; level_position ;
+           cycle ; cycle_position ;
            voting_period; voting_period_position } ->
-      (level, cycle, cycle_position,
+      (level, level_position,
+       cycle, cycle_position,
        voting_period, voting_period_position))
-    (fun (level, cycle, cycle_position,
+    (fun (level, level_position,
+          cycle, cycle_position,
           voting_period, voting_period_position) ->
-       { level ; cycle ; cycle_position ;
+      { level ; level_position ;
+        cycle ; cycle_position ;
          voting_period ; voting_period_position })
-    (obj5
+    (obj6
        (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))
 
-let root =
+let root first_level =
-  { level = Raw_level_repr.root ;
+  { level = first_level ;
+    level_position = 0l ;
     cycle = Cycle_repr.root ;
     cycle_position = 0l ;
     voting_period = Voting_period_repr.root ;
     voting_period_position = 0l ;
   }
 
-let from_raw ~cycle_length ~voting_period_length level =
+let from_raw ~first_level ~cycle_length ~voting_period_length level =
   let raw_level = Raw_level_repr.to_int32 level in
-  let cycle = Cycle_repr.of_int32_exn (Int32.div raw_level cycle_length) in
+  let first_level = Raw_level_repr.to_int32 first_level in
-  let cycle_position = Int32.rem raw_level cycle_length in
+  let level_position =
+    Compare.Int32.max 0l (Int32.sub raw_level first_level) in
+  let cycle =
+    Cycle_repr.of_int32_exn (Int32.div level_position cycle_length) in
+  let cycle_position = Int32.rem level_position cycle_length in
   let voting_period =
     Voting_period_repr.of_int32_exn
-      (Int32.div raw_level voting_period_length) in
+      (Int32.div level_position voting_period_length) in
   let voting_period_position =
-    Int32.rem raw_level voting_period_length in
+    Int32.rem level_position voting_period_length in
-  { level ; cycle ; cycle_position ;
+  { level ; level_position ;
+    cycle ; cycle_position ;
     voting_period ; voting_period_position }
 
 let diff { level = l1 } { level = l2 } =

src/proto/alpha/level_repr.mli

@@ -9,6 +9,7 @@
 
 type t = private {
   level: Raw_level_repr.t ;
+  level_position: int32 ;
   cycle: Cycle_repr.t ;
   cycle_position: int32 ;
   voting_period: Voting_period_repr.t ;
@@ -21,10 +22,12 @@ val pp: Format.formatter -> level -> unit
 val pp_full: Format.formatter -> level -> unit
 include Compare.S with type t := level
 
-val root: level
+val root: Raw_level_repr.t -> level
 
 val from_raw:
-  cycle_length:int32 -> voting_period_length:int32 ->
+  first_level:Raw_level_repr.t ->
+  cycle_length:int32 ->
+  voting_period_length:int32 ->
   Raw_level_repr.t -> level
 
 val diff: level -> level -> int32

src/proto/alpha/level_storage.ml

@@ -15,31 +15,29 @@ let from_raw c ?offset l =
     | None -> l
     | Some o -> Raw_level_repr.(of_int32_exn (Int32.add (to_int32 l) o)) in
   let constants = Storage.constants c in
+  let first_level = Storage.first_level c in
   Level_repr.from_raw
+    ~first_level
     ~cycle_length:constants.Constants_repr.cycle_length
     ~voting_period_length:constants.Constants_repr.voting_period_length
     l
 
+let root c =
+  Level_repr.root (Storage.first_level c)
+
 let succ c l = from_raw c (Raw_level_repr.succ l.level)
 let pred c l =
   match Raw_level_repr.pred l.Level_repr.level with
   | None -> None
   | Some l -> Some (from_raw c l)
 
-let current ctxt =
+let current ctxt = Storage.current_level ctxt
-  Storage.Current_level.get ctxt >>=? fun l ->
-  return (from_raw ctxt l)
 
 let previous ctxt =
-  current ctxt >>=? fun l ->
+  let l = current ctxt in
   match pred ctxt l with
-  | None -> assert false (* Context inited with level = 1. *)
+  | None -> assert false (* We never validate the Genesis... *)
-  | Some p -> return p
+  | Some p -> p
-
-let increment_current ctxt =
-  Storage.Current_level.get ctxt >>=? fun l ->
-  Storage.Current_level.set ctxt (Raw_level_repr.succ l)
-
 
 let first_level_in_cycle ctxt c =
   let constants = Storage.constants ctxt in
@@ -60,8 +58,3 @@ let levels_in_cycle ctxt c =
     else acc
   in
   loop first []
-
-let init ctxt =
-  Storage.Current_level.init ctxt Raw_level_repr.(succ root)
-
-

src/proto/alpha/level_storage.mli

@@ -7,11 +7,10 @@
 (*                                                                        *)
 (**************************************************************************)
 
-val init: Storage.t -> Storage.t tzresult Lwt.t
+val current: Storage.t -> Level_repr.t
+val previous: Storage.t -> Level_repr.t
 
-val increment_current: Storage.t -> Storage.t tzresult Lwt.t
+val root: Storage.t -> Level_repr.t
-val current: Storage.t -> Level_repr.t tzresult Lwt.t
-val previous: Storage.t -> Level_repr.t tzresult Lwt.t
 
 val from_raw: Storage.t -> ?offset:int32 -> Raw_level_repr.t -> Level_repr.t
 val pred: Storage.t -> Level_repr.t -> Level_repr.t option

src/proto/alpha/main.ml

@@ -50,8 +50,10 @@ let begin_application
     ~predecessor_fitness:pred_fitness
     raw_block =
   Lwt.return (Tezos_context.Block.parse_header raw_block) >>=? fun header ->
+  let level = header.shell.level in
+  let fitness = pred_fitness in
   let timestamp = header.shell.timestamp in
-  Tezos_context.init ~timestamp ~fitness:pred_fitness ctxt >>=? fun ctxt ->
+  Tezos_context.init ~level ~timestamp ~fitness ctxt >>=? fun ctxt ->
   Apply.begin_application ctxt header pred_timestamp >>=? fun (ctxt, miner) ->
   let mode = Application (header, miner) in
   return { mode ; ctxt ; op_count = 0 }
@@ -59,11 +61,14 @@ let begin_application
 let begin_construction
     ~predecessor_context:ctxt
     ~predecessor_timestamp:_
+    ~predecessor_level:pred_level
     ~predecessor_fitness:pred_fitness
     ~predecessor:pred_block
     ~timestamp =
   let mode = Construction { pred_block ; timestamp } in
-  Tezos_context.init ~timestamp ~fitness:pred_fitness ctxt >>=? fun ctxt ->
+  let level = Int32.succ pred_level in
+  let fitness = pred_fitness in
+  Tezos_context.init ~timestamp ~level ~fitness ctxt >>=? fun ctxt ->
   let ctxt = Apply.begin_construction ctxt in
   return { mode ; ctxt ; op_count = 0 }
 
@@ -74,7 +79,7 @@ let apply_operation ({ mode ; ctxt ; op_count } as data) operation =
         pred_block, 0, None
     | Application (block, delegate) ->
         block.shell.predecessor,
-        block.proto.mining_slot.priority,
+        block.proto.priority,
         Some (Tezos_context.Contract.default_contract delegate) in
   Apply.apply_operation
     ctxt miner_contract pred_block block_prio operation
@@ -88,8 +93,9 @@ let finalize_block { mode ; ctxt ; op_count } = match mode with
       return ctxt
   | Application (block, miner) ->
       Apply.finalize_application ctxt block miner >>=? fun ctxt ->
-      Tezos_context.Level.current ctxt >>=? fun { level } ->
+      let { level } : Tezos_context.Level.t =
-      let priority = block.proto.mining_slot.priority in
+        Tezos_context. Level.current ctxt in
+      let priority = block.proto.priority in
       let level = Tezos_context.Raw_level.to_int32 level in
       let fitness = Tezos_context.Fitness.current ctxt in
       let commit_message =

src/proto/alpha/mining.ml

@@ -14,7 +14,6 @@ open Misc
 type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *)
 type error += Invalid_endorsement_slot of int * int (* `Permanent *)
 type error += Timestamp_too_early of Timestamp.t * Timestamp.t (* `Permanent *)
-type error += Wrong_level of Raw_level.t * Raw_level.t (* `Permanent *)
 type error += Wrong_delegate of public_key_hash * public_key_hash (* `Permanent *)
 type error += Cannot_pay_mining_bond (* `Permanent *)
 type error += Cannot_pay_endorsement_bond (* `Permanent *)
@@ -60,20 +59,6 @@ let () =
                      (req "provided" int16))
     (function Invalid_endorsement_slot (m, g)   -> Some (m, g) | _ -> None)
     (fun (m, g) -> Invalid_endorsement_slot (m, g)) ;
-  register_error_kind
-    `Permanent
-    ~id:"mining.wrong_level"
-    ~title:"Wrong level"
-    ~description:"The block level is not the expected one"
-    ~pp:(fun ppf (e, g) ->
-        Format.fprintf ppf
-          "The declared level %a is not %a"
-          Raw_level.pp g Raw_level.pp e)
-    Data_encoding.(obj2
-                     (req "expected" Raw_level.encoding)
-                     (req "provided" Raw_level.encoding))
-    (function Wrong_level (e, g)   -> Some (e, g) | _ -> None)
-    (fun (e, g) -> Wrong_level (e, g)) ;
   register_error_kind
     `Permanent
     ~id:"mining.wrong_delegate"
@@ -133,21 +118,14 @@ let check_timestamp c priority pred_timestamp =
   fail_unless Timestamp.(minimal_time <= timestamp)
     (Timestamp_too_early (minimal_time, timestamp))
 
-let check_mining_rights c
+let check_mining_rights c { Block.proto = { priority } }
-    { Block.proto = { mining_slot = { level = raw_level ; priority } } }
     pred_timestamp =
-  Level.current c >>=? fun current_level ->
+  let level = Level.current c in
-  fail_unless
-    Raw_level.(raw_level = current_level.level)
-    (Wrong_level (current_level.Level.level, raw_level)) >>=? fun () ->
-  let level = Level.from_raw c raw_level in
   Roll.mining_rights_owner c level ~priority >>=? fun delegate ->
   check_timestamp c priority pred_timestamp >>=? fun () ->
   return delegate
 
-let pay_mining_bond c
+let pay_mining_bond c { Block.proto = { priority } } id =
-    { Block.proto = { mining_slot = { priority} } }
-    id =
   if Compare.Int.(priority >= Constants.first_free_mining_slot c)
   then return c
   else
@@ -163,7 +141,7 @@ let pay_endorsement_bond c id =
 let check_signing_rights c slot delegate =
   fail_unless Compare.Int.(0 <= slot && slot <= Constants.max_signing_slot c)
     (Invalid_endorsement_slot (Constants.max_signing_slot c, slot)) >>=? fun () ->
-  Level.current c >>=? fun level ->
+  let level = Level.current c in
   Roll.endorsement_rights_owner c level ~slot >>=? fun owning_delegate ->
   fail_unless (Ed25519.Public_key_hash.equal owning_delegate delegate)
     (Wrong_delegate (owning_delegate, delegate))
@@ -281,12 +259,13 @@ let check_fitness_gap ctxt (block : Block.header) =
   else
     return ()
 
-let first_of_a_cycle l =
+let last_of_a_cycle ctxt l =
-  Compare.Int32.(l.Level.cycle_position = 0l)
+  Compare.Int32.(Int32.succ l.Level.cycle_position =
+                 Constants.cycle_length ctxt)
 
 let dawn_of_a_new_cycle ctxt =
-  Level.current ctxt >>=? fun level ->
+  let level = Level.current ctxt in
-  if first_of_a_cycle level then
+  if last_of_a_cycle ctxt level then
     return (Some level.cycle)
   else
     return None

src/proto/alpha/mining.mli

@@ -14,7 +14,6 @@ open Misc
 type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *)
 type error += Invalid_endorsement_slot of int * int (* `Permanent *)
 type error += Timestamp_too_early of Timestamp.t * Timestamp.t (* `Permanent *)
-type error += Wrong_level of Raw_level.t * Raw_level.t (* `Permanent *)
 type error += Wrong_delegate of public_key_hash * public_key_hash (* `Permanent *)
 type error += Cannot_pay_mining_bond (* `Permanent *)
 type error += Cannot_pay_endorsement_bond (* `Permanent *)

src/proto/alpha/nonce_storage.ml

@@ -18,7 +18,7 @@ type error +=
   | Unexpected_nonce
 
 let get_unrevealed c level =
-  Level_storage.current c >>=? fun cur_level ->
+  let cur_level = Level_storage.current c in
   let min_cycle =
     match Cycle_repr.pred cur_level.cycle with
     | None -> Cycle_repr.root
@@ -40,7 +40,7 @@ let get_unrevealed c level =
   (* return nonce_hash *)
 
 let record_hash c delegate_to_reward reward_amount nonce_hash =
-  Level_storage.current c >>=? fun level ->
+  let level = Level_storage.current c in
   Storage.Seed.Nonce.init c level
     (Unrevealed { nonce_hash; delegate_to_reward ; reward_amount })
 
@@ -65,6 +65,3 @@ let get c level = Storage.Seed.Nonce.get c level
 let of_bytes = Seed_repr.make_nonce
 let hash = Seed_repr.hash
 let check_hash = Seed_repr.check_hash
-
-let init c =
-  Storage.Seed.Nonce.init c Level_repr.root (Revealed Seed_repr.initial_nonce_0)

src/proto/alpha/nonce_storage.mli

@@ -41,6 +41,3 @@ val get: Storage.t -> Level_repr.t -> status tzresult Lwt.t
 val of_bytes: MBytes.t -> nonce tzresult
 val hash: nonce -> Nonce_hash.t
 val check_hash: nonce -> Nonce_hash.t -> bool
-
-val init:
-  Storage.t -> Storage.t tzresult Lwt.t

src/proto/alpha/raw_level_repr.ml

@@ -39,3 +39,9 @@ let of_int32_exn l =
   if Compare.Int32.(l >= 0l)
   then l
   else invalid_arg "Level_repr.of_int32"
+
+type error += Unexpected_level of Int32.t
+
+let of_int32 l =
+  try Ok (of_int32_exn l)
+  with _ -> Error [Unexpected_level l]

src/proto/alpha/raw_level_repr.mli

@@ -16,6 +16,7 @@ include Compare.S with type t := raw_level
 
 val to_int32: raw_level -> int32
 val of_int32_exn: int32 -> raw_level
+val of_int32: int32 -> raw_level tzresult
 
 val diff: raw_level -> raw_level -> int32
 

src/proto/alpha/seed_storage.ml

@@ -45,7 +45,7 @@ let compute_for_cycle c cycle =
   | c -> Lwt.return c
 
 let for_cycle c cycle =
-  Level_storage.current c >>=? fun current_level ->
+  let current_level = Level_storage.current c in
   let current_cycle = current_level.cycle in
   let next_cycle = (Level_storage.succ c current_level).cycle in
   fail_unless

src/proto/alpha/services_registration.ml

@@ -9,8 +9,8 @@
 
 open Tezos_context
 
-let rpc_init { Updater.context ; timestamp ; fitness } =
+let rpc_init { Updater.context ; level ; timestamp ; fitness } =
-  Tezos_context.init ~timestamp ~fitness context
+  Tezos_context.init ~level ~timestamp ~fitness context
 
 let rpc_services = ref (RPC.empty : Updater.rpc_context RPC.directory)
 let register0 s f =
@@ -95,7 +95,7 @@ let () =
 type error += Unexpected_level_in_context
 
 let level ctxt =
-  Level.current ctxt >>=? fun level ->
+  let level = Level.current ctxt in
   match Level.pred ctxt level with
   | None -> fail Unexpected_level_in_context
   | Some level -> return level
@@ -103,7 +103,7 @@ let level ctxt =
 let () = register0 Services.Context.level level
 
 let next_level ctxt =
-  Level.current ctxt
+  return (Level.current ctxt)
 
 let () = register0 Services.Context.next_level next_level
 
@@ -193,7 +193,7 @@ let () =
        | None -> Error_monad.fail Operation.Cannot_parse_operation
        | Some (shell, contents) ->
            let operation = { hash ; shell ; contents ; signature } in
-           Tezos_context.Level.current ctxt >>=? fun level ->
+           let level = Tezos_context.Level.current ctxt in
            Mining.mining_priorities ctxt level >>=? fun (Misc.LCons (miner_pkh, _)) ->
            let miner_contract = Contract.default_contract miner_pkh in
            let block_prio = 0 in
@@ -302,7 +302,7 @@ let mining_rights ctxt level max =
 let () =
   register1 Services.Helpers.Rights.mining_rights
     (fun ctxt max ->
-       Level.current ctxt >>=? fun level ->
+       let level = Level.current ctxt in
        mining_rights ctxt level max >>=? fun (raw_level, slots) ->
        begin
          Lwt_list.filter_map_p (fun x -> x) @@
@@ -325,7 +325,7 @@ let () =
 let mining_rights_for_delegate
     ctxt contract (max_priority, min_level, max_level) =
   let max_priority = default_max_mining_priority ctxt max_priority in
-  Level.current ctxt >>=? fun current_level ->
+  let current_level = Level.current ctxt in
   let max_level =
     match max_level with
     | None ->
@@ -381,7 +381,7 @@ let endorsement_rights ctxt level max =
 let () =
   register1 Services.Helpers.Rights.endorsement_rights
     (fun ctxt max ->
-       Level.current ctxt >>=? fun level ->
+       let level = Level.current ctxt in
        endorsement_rights ctxt (Level.succ ctxt level) max) ;
   register2 Services.Helpers.Rights.endorsement_rights_for_level
     (fun ctxt raw_level max ->
@@ -390,7 +390,7 @@ let () =
 
 let endorsement_rights_for_delegate
     ctxt contract (max_priority, min_level, max_level) =
-  Level.current ctxt >>=? fun current_level ->
+  let current_level = Level.current ctxt in
   let max_priority = default_max_endorsement_priority ctxt max_priority in
   let max_level =
     match max_level with
@@ -435,11 +435,12 @@ let () = register1 Services.Helpers.Forge.operations forge_operations
 
 let forge_block _ctxt
     (net_id, predecessor, timestamp, fitness, operations,
-     raw_level, priority, seed_nonce_hash, proof_of_work_nonce) : MBytes.t tzresult Lwt.t =
+     level, priority, seed_nonce_hash, proof_of_work_nonce) : MBytes.t tzresult Lwt.t =
-  let mining_slot = { Block.level = raw_level ; priority } in
+  let level = Raw_level.to_int32 level in
   return (Block.forge_header
-            { net_id ; predecessor ; timestamp ; fitness ; operations }
+            { net_id ; level ; predecessor ;
-            { mining_slot ; seed_nonce_hash ; proof_of_work_nonce })
+              timestamp ; fitness ; operations }
+            { priority ; seed_nonce_hash ; proof_of_work_nonce })
 
 let () = register1 Services.Helpers.Forge.block forge_block
 

src/proto/alpha/storage.ml

@@ -10,17 +10,55 @@
 open Tezos_hash
 open Storage_functors
 
+(* This key should always be populated for every version of the
+   protocol.  It's absence meaning that the context is empty. *)
+let version_key = ["version"]
+let version_value = "alpha"
+
+type error += Incompatiple_protocol_version
+
+let is_first_block ctxt =
+  Context.get ctxt version_key >>= function
+  | None ->
+      return true
+  | Some bytes ->
+      let s = MBytes.to_string bytes in
+      if Compare.String.(s = version_value) then
+        return false
+      else if Compare.String.(s = "genesis") then
+        return true
+      else
+        fail Incompatiple_protocol_version
+
 let version = "v1"
+let first_level_key = [ version ; "first_level" ]
 let sandboxed_key = [ version ; "sandboxed" ]
 
 type t = Storage_functors.context
 
 type error += Invalid_sandbox_parameter
 
+let current_level { level } = level
 let current_timestamp { timestamp } = timestamp
 let current_fitness { fitness } = fitness
 let set_current_fitness c fitness = { c with fitness }
 
+let get_first_level ctxt =
+  Context.get ctxt first_level_key >>= function
+  | None -> failwith "Invalid context"
+  | Some bytes ->
+      match
+        Data_encoding.Binary.of_bytes Raw_level_repr.encoding bytes
+      with
+      | None -> failwith "Invalid context"
+      | Some level -> return level
+
+let set_first_level ctxt level =
+  let bytes =
+    Data_encoding.Binary.to_bytes Raw_level_repr.encoding level in
+  Context.set ctxt first_level_key bytes >>= fun ctxt ->
+  return ctxt
+
 let get_sandboxed c =
   Context.get c sandboxed_key >>= function
   | None -> return None
@@ -33,21 +71,41 @@ let set_sandboxed c json =
   Context.set c sandboxed_key
     (Data_encoding.Binary.to_bytes Data_encoding.json json)
 
-let prepare ~timestamp ~fitness (c : Context.t) : t tzresult Lwt.t =
+let may_tag_first_block ctxt level =
+  is_first_block ctxt >>=? function
+  | false ->
+      get_first_level ctxt >>=? fun level ->
+      return (ctxt, false, level)
+  | true ->
+      Context.set ctxt version_key
+        (MBytes.of_string version_value) >>= fun ctxt ->
+      set_first_level ctxt level >>=? fun ctxt ->
+      return (ctxt, true, level)
+
+let prepare ~level ~timestamp ~fitness ctxt =
+  Lwt.return (Raw_level_repr.of_int32 level ) >>=? fun level ->
   Lwt.return (Fitness_repr.to_int64 fitness) >>=? fun fitness ->
-  get_sandboxed c >>=? fun sandbox ->
+  may_tag_first_block ctxt level >>=? fun (ctxt, first_block, first_level) ->
+  get_sandboxed ctxt >>=? fun sandbox ->
   Constants_repr.read sandbox >>=? function constants ->
-  return { context = c ; constants ; timestamp ; fitness }
+  let level =
+    Level_repr.from_raw
+      ~first_level
+      ~cycle_length:constants.Constants_repr.cycle_length
+      ~voting_period_length:constants.Constants_repr.voting_period_length
+    level in
+  return ({ context = ctxt ; constants ; level ;
+            timestamp ; fitness ; first_level},
+          first_block)
 let recover { context } : Context.t = context
 
+let first_level { first_level } = first_level
 let constants { constants } = constants
 
 module Key = struct
 
   let store_root tail = version :: "store" :: tail
 
-  let current_level = store_root ["level"]
-
   let global_counter = store_root ["global_counter"]
 
   let next_cycle_to_be_rewarded = store_root ["next_cycle_to_be_rewarded"]
@@ -119,16 +177,6 @@ module Key = struct
 
 end
 
-(** Global *)
-
-module Current_level =
-  Make_single_data_storage(struct
-    type value = Raw_level_repr.t
-    let name = "level"
-    let key = Key.current_level
-    let encoding = Raw_level_repr.encoding
-  end)
-
 (** Rolls *)
 
 module Roll = struct

src/proto/alpha/storage.mli

@@ -24,11 +24,17 @@
 (** Abstract view of the database *)
 type t
 
-(** Rerieves the state of the database and gives its abstract view *)
+(** Is first block validated with this version of the protocol ? *)
+val is_first_block: Context.t -> bool tzresult Lwt.t
+
+(** Retrieves the state of the database and gives its abstract view.
+    It also returns wether this is the first block validated
+    with this version of the protocol. *)
 val prepare :
+  level: Int32.t ->
   timestamp: Time.t ->
   fitness: Fitness.fitness ->
-  Context.t -> t tzresult Lwt.t
+  Context.t -> (t * bool) tzresult Lwt.t
 
 (** Returns the state of the database resulting of operations on its
     abstract view *)
@@ -37,22 +43,19 @@ val recover : t -> Context.t
 val get_sandboxed : Context.t -> Data_encoding.json option tzresult Lwt.t
 val set_sandboxed : Context.t -> Data_encoding.json -> Context.t Lwt.t
 
+val current_level : t -> Level_repr.t
 val current_timestamp : t -> Time.t
 
 val current_fitness : t -> Int64.t
 val set_current_fitness : t -> Int64.t -> t
 
 val constants : t -> Constants_repr.constants
+val first_level : t -> Raw_level_repr.t
 
 (** {1 Entity Accessors} *****************************************************)
 
 open Storage_sigs
 
-(** The level of the current block *)
-module Current_level : Single_data_storage
-  with type value = Raw_level_repr.t
-   and type context := t
-
 module Roll : sig
 
   (** Storage from this submodule must only be accessed through the

src/proto/alpha/storage_functors.ml

@@ -14,6 +14,8 @@ open Misc
 type context = {
   context: Context.t ;
   constants: Constants_repr.constants ;
+  first_level: Raw_level_repr.t ;
+  level: Level_repr.t ;
   timestamp: Time.t ;
   fitness: Int64.t ;
 }

src/proto/alpha/storage_functors.mli

@@ -17,6 +17,8 @@
 type context = {
   context: Context.t ;
   constants: Constants_repr.constants ;
+  first_level: Raw_level_repr.t ;
+  level: Level_repr.t ;
   timestamp: Time.t ;
   fitness: Int64.t ;
 }

src/proto/alpha/tezos_context.mli

@@ -219,6 +219,7 @@ module Level : sig
 
   type t = private {
     level: Raw_level.t ;
+    level_position: int32 ;
     cycle: Cycle.t ;
     cycle_position: int32 ;
     voting_period: Voting_period.t ;
@@ -228,7 +229,7 @@ module Level : sig
   val pp_full: Format.formatter -> t -> unit
   type level = t
 
-  val root: level
+  val root: context -> level
 
   val succ: context -> level -> level
   val pred: context -> level -> level option
@@ -237,8 +238,7 @@ module Level : sig
 
   val diff: level -> level -> int32
 
-  val current: context -> level tzresult Lwt.t
+  val current: context -> level
-  val increment_current: context -> context tzresult Lwt.t
 
   val last_level_in_cycle: context -> Cycle.t -> level
   val levels_in_cycle: context -> Cycle.t -> level list
@@ -523,18 +523,11 @@ module Block : sig
   }
 
   and proto_header = {
-    mining_slot: mining_slot ;
+    priority: int ;
     seed_nonce_hash: Nonce_hash.t ;
     proof_of_work_nonce: MBytes.t ;
   }
 
-  and mining_slot = {
-    level: Raw_level.t ;
-    priority: int ;
-  }
-
-  val mining_slot_encoding: mining_slot Data_encoding.encoding
-
   val max_header_length: int
 
   val parse_header: Updater.raw_block -> header tzresult
@@ -580,6 +573,7 @@ end
 
 val init:
   Context.t ->
+  level:Int32.t ->
   timestamp:Time.t ->
   fitness:Fitness.t ->
   context tzresult Lwt.t

src/proto/demo/main.ml

@@ -71,6 +71,7 @@ let begin_application
 let begin_construction
     ~predecessor_context:context
     ~predecessor_timestamp:_
+    ~predecessor_level:_
     ~predecessor_fitness:pred_fitness
     ~predecessor:_
     ~timestamp:_ =

src/proto/environment/updater.mli

@@ -19,6 +19,8 @@ val raw_operation_encoding: raw_operation Data_encoding.t
 type shell_block = {
   net_id: Net_id.t ;
   (** The genesis of the chain this block belongs to. *)
+  level: Int32.t ;
+  (** The number of predecessing block in the chain. *)
   predecessor: Block_hash.t ;
   (** The preceding block in the chain. *)
   timestamp: Time.t ;
@@ -46,6 +48,7 @@ type validation_result = {
 
 type rpc_context = {
   context: Context.t ;
+  level: Int32.t ;
   timestamp: Time.t ;
   fitness: Fitness.fitness ;
 }
@@ -124,6 +127,7 @@ module type PROTOCOL = sig
   val begin_construction :
     predecessor_context: Context.t ->
     predecessor_timestamp: Time.t ->
+    predecessor_level: Int32.t ->
     predecessor_fitness: Fitness.fitness ->
     predecessor: Block_hash.t ->
     timestamp: Time.t ->

src/proto/genesis/main.ml

@@ -98,6 +98,7 @@ let begin_application
 let begin_construction
     ~predecessor_context:context
     ~predecessor_timestamp:_
+    ~predecessor_level:_
     ~predecessor_fitness:fitness
     ~predecessor:_
     ~timestamp:_ =

src/proto/genesis/services.ml

@@ -38,8 +38,9 @@ module Forge = struct
       ~description: "Forge a block"
       ~input:
         (merge_objs
-           (obj4
+           (obj5
               (req "net_id" Net_id.encoding)
+              (req "level" int32)
               (req "predecessor" Block_hash.encoding)
               (req "timestamp" Time.encoding)
               (req "fitness" Fitness.encoding))
@@ -62,9 +63,9 @@ let rpc_services : Updater.rpc_context RPC.directory =
     RPC.register
       dir
       (Forge.block RPC.Path.root)
-      (fun _ctxt ((net_id, predecessor, timestamp, fitness), command) ->
+      (fun _ctxt ((net_id, level, predecessor, timestamp, fitness), command) ->
-         let shell = { Updater.net_id ; predecessor ; timestamp ; fitness ;
+         let shell = { Updater.net_id ; level ; predecessor ;
-                       operations } in
+                       timestamp ; fitness ; operations } in
          let bytes = Data.Command.forge shell command in
          RPC.Answer.return bytes) in
   dir

test/proto_alpha/proto_alpha_helpers.ml

@@ -361,7 +361,7 @@ module Mining = struct
       block
       delegate_sk
       shell
-      mining_slot
+      priority
       seed_nonce_hash =
     Client_proto_rpcs.Constants.stamp_threshold
       rpc_config block >>=? fun stamp_threshold ->
@@ -370,7 +370,7 @@ module Mining = struct
         Sodium.Random.Bigbytes.generate Constants.proof_of_work_nonce_size in
       let unsigned_header =
         Block.forge_header
-          shell { mining_slot ; seed_nonce_hash ; proof_of_work_nonce } in
+          shell { priority ; seed_nonce_hash ; proof_of_work_nonce } in
       let signed_header =
         Environment.Ed25519.Signature.append delegate_sk unsigned_header in
       let block_hash = Block_hash.hash_bytes [signed_header] in
@@ -398,10 +398,9 @@ module Mining = struct
         [Operation_list_hash.compute operation_list] in
     let shell =
       { Store.Block_header.net_id = bi.net ; predecessor = bi.hash ;
-        timestamp ; fitness ; operations } in
+        timestamp ; fitness ; operations ; level = Raw_level.to_int32 level.level } in
-    let slot = { Block.level = level.level ; priority } in
     mine_stamp
-      block src_sk shell slot seed_nonce_hash >>=? fun proof_of_work_nonce ->
+      block src_sk shell priority seed_nonce_hash >>=? fun proof_of_work_nonce ->
     Client_proto_rpcs.Helpers.Forge.block rpc_config
       block
       ~net:bi.net
@@ -553,3 +552,8 @@ module Endorse = struct
       block delegate ()
 
 end
+
+let display_level block =
+  Client_proto_rpcs.Context.level rpc_config block >>=? fun lvl ->
+  Format.eprintf "Level: %a@." Level.pp_full lvl ;
+  return ()

test/proto_alpha/proto_alpha_helpers.mli

@@ -105,7 +105,7 @@ module Mining : sig
     Client_proto_rpcs.block ->
     secret_key ->
     Updater.shell_block ->
-    Block.mining_slot ->
+    int ->
     Nonce_hash.t ->
     MBytes.t tzresult Lwt.t
 
@@ -192,3 +192,7 @@ module Assert : sig
   val invalid_endorsement_slot : msg:string -> 'a tzresult -> unit
 
 end
+
+val rpc_config: Client_rpcs.config
+
+val display_level: Client_proto_rpcs.block -> unit tzresult Lwt.t

test/proto_alpha/test_endorsement.ml

@@ -9,6 +9,7 @@
 
 open Client_embedded_proto_alpha
 open Tezos_context
+open Client_alpha
 
 module Helpers = Proto_alpha_helpers
 module Assert = Helpers.Assert
@@ -77,7 +78,7 @@ let test_invalid_endorsement_slot contract block =
   return ()
 
 let test_endorsement_rewards
-    block ({ Helpers.Account.b1 ; _ } as baccounts) =
+    block ({ Helpers.Account.b5 = b1 ; _ } as baccounts) =
   let get_endorser_except_b1 accounts =
     let account, cpt = ref accounts.(0), ref 0 in
     while !account = b1 do
@@ -95,9 +96,11 @@ let test_endorsement_rewards
   Helpers.Account.balance account0 >>=? fun balance0 ->
   Helpers.Endorse.endorse ~slot:slot0 ~force:true account0 block >>=? fun ops ->
   Helpers.Mining.mine ~fitness_gap:2 ~operations:[ ops ] b1 block >>=? fun head0 ->
+  Helpers.display_level (`Hash head0) >>=? fun () ->
   Assert.balance_equal ~msg:__LOC__ account0
     (Int64.sub (Tez.to_cents balance0) bond) >>=? fun () ->
 
+
   (* #2 endorse & inject in a block  *)
   let block0 = `Hash head0 in
   Helpers.Endorse.endorsers_list block0 baccounts >>=? fun accounts ->
@@ -105,9 +108,11 @@ let test_endorsement_rewards
   Helpers.Account.balance account1 >>=? fun balance1 ->
   Helpers.Endorse.endorse ~slot:slot1 ~force:true account1 block0 >>=? fun ops ->
   Helpers.Mining.mine ~fitness_gap:2 ~operations:[ ops ] b1 block0 >>=? fun head1 ->
+  Helpers.display_level (`Hash head1) >>=? fun () ->
   Assert.balance_equal ~msg:__LOC__ account1
     (Int64.sub (Tez.to_cents balance1) bond) >>=? fun () ->
 
+
   (* #3 endorse but the operation is not included in a block, so no reward  *)
   let block1 = `Hash head1 in
   Helpers.Endorse.endorsers_list block1 baccounts >>=? fun accounts ->
@@ -118,7 +123,11 @@ let test_endorsement_rewards
     (Int64.sub (Tez.to_cents balance2) bond) >>=? fun () ->
 
   Helpers.Mining.mine ~fitness_gap:1 b1 (`Hash head1) >>=? fun head2 ->
+  Helpers.display_level (`Hash head2) >>=? fun () ->
   Helpers.Mining.mine ~fitness_gap:1 b1 (`Hash head2) >>=? fun head3 ->
+  Helpers.display_level (`Hash head3) >>=? fun () ->
+  Helpers.Mining.mine ~fitness_gap:1 b1 (`Hash head3) >>=? fun head4 ->
+  Helpers.display_level (`Hash head4) >>=? fun () ->
 
   (* Check rewards after one cycle for account0 *)
   Helpers.Mining.endorsement_reward b1 block0 >>=? fun rw0 ->
@@ -135,8 +144,10 @@ let test_endorsement_rewards
     ~msg:__LOC__ account2 (Tez.to_cents balance2) >>=? fun () ->
 
   (* #2 endorse and check reward only on the good chain  *)
-  Helpers.Mining.mine ~fitness_gap:1 b1 (`Hash head3) >>=? fun head ->
+  Helpers.Mining.mine ~fitness_gap:1 b1 (`Hash head4) >>=? fun head ->
-  Helpers.Mining.mine ~fitness_gap:1 b1 (`Hash head3) >>=? fun fork ->
+  Helpers.display_level (`Hash head) >>=? fun () ->
+  Helpers.Mining.mine ~fitness_gap:1 b1 (`Hash head4) >>=? fun fork ->
+  Helpers.display_level (`Hash fork) >>=? fun () ->
 
   (* working on head *)
   Helpers.Endorse.endorsers_list (`Hash head) baccounts >>=? fun accounts ->
@@ -145,6 +156,7 @@ let test_endorsement_rewards
   Helpers.Endorse.endorse
     ~slot:slot3 ~force:true account3 (`Hash head) >>=? fun ops ->
   Helpers.Mining.mine ~fitness_gap:2 ~operations:[ ops ] b1 (`Hash head) >>=? fun new_head ->
+  Helpers.display_level (`Hash new_head) >>=? fun () ->
 
   (* working on fork *)
   Helpers.Endorse.endorsers_list (`Hash fork) baccounts >>=? fun accounts ->
@@ -152,10 +164,13 @@ let test_endorsement_rewards
   Helpers.Account.balance account4 >>=? fun _balance4 ->
   Helpers.Endorse.endorse ~slot:slot4 ~force:true account4 (`Hash fork) >>=? fun ops ->
   Helpers.Mining.mine ~fitness_gap:2 ~operations:[ ops ] b1 (`Hash fork) >>=? fun _new_fork ->
+  Helpers.display_level (`Hash _new_fork) >>=? fun () ->
   Helpers.Account.balance account4 >>=? fun balance4 ->
 
   Helpers.Mining.mine ~fitness_gap:1 b1 (`Hash new_head) >>=? fun head ->
+  Helpers.display_level (`Hash head) >>=? fun () ->
   Helpers.Mining.mine ~fitness_gap:1 b1 (`Hash head) >>=? fun head ->
+  Helpers.display_level (`Hash head) >>=? fun () ->
 
   (* Check rewards after one cycle *)
   Helpers.Mining.endorsement_reward b1 (`Hash new_head) >>=? fun reward ->
@@ -209,7 +224,7 @@ let run head (({ b1 ; b2 ; b3 ; b4 ; b5 } : Helpers.Account.bootstrap_accounts)
   (* FIXME: cannot inject double endorsement operation yet, but the
      code is still here
      Double endorsement *)
-  test_double_endorsement b5 (`Hash head) >>=? fun new_head ->
+  test_double_endorsement b4 (`Hash head) >>=? fun new_head ->
 
   return new_head
 

test/shell/test_state.ml

@@ -69,6 +69,7 @@ let block _state ?(operations = []) pred_hash pred name : Store.Block_header.t =
   let timestamp = incr_timestamp pred.shell.timestamp in
   { shell = {
         net_id = pred.shell.net_id ;
+        level = Int32.succ pred.shell.level ;
         predecessor = pred_hash ;
         timestamp ; operations; fitness } ;
     proto = MBytes.of_string name ;
@@ -139,6 +140,7 @@ let block _state ?(operations = []) (pred: State.Valid_block.t) name
   let fitness = incr_fitness pred.fitness in
   let timestamp = incr_timestamp pred.timestamp in
   { shell = { net_id = pred.net_id ;
+              level = Int32.succ pred.level ;
               predecessor = pred.hash ;
               timestamp ; operations; fitness } ;
     proto = MBytes.of_string name ;

test/shell/test_store.ml

@@ -94,6 +94,7 @@ let lolblock ?(operations = []) header =
       [Operation_list_hash.compute operations] in
   { Store.Block_header.shell =
       { timestamp = Time.of_seconds (Random.int64 1500L) ;
+        level = 0l ; (* dummy *)
         net_id ;
         predecessor = genesis_block ; operations ;
         fitness = [MBytes.of_string @@ string_of_int @@ String.length header;