Proto: export the 'last_allowed_fork_level'.

The should ignore all branch forking at a block whose level
is lower than the 'last_allowed_fork_level' of the current head.

src/bin_client/test/demo/main.ml

@@ -89,7 +89,9 @@ let finalize_block ctxt =
   let message = Some (Format.asprintf "fitness <- %Ld" fitness) in
   let fitness = Fitness.from_int64 fitness in
   return { Updater.message ; context = ctxt.context ; fitness ;
-           max_operations_ttl = 0 ; max_operation_data_length = 0 }
+           max_operations_ttl = 0 ; max_operation_data_length = 0 ;
+           last_allowed_fork_level = 0l ;
+         }
 
 let rpc_services = RPC_directory.empty
 

src/lib_protocol_environment/sigs/v1/updater.mli

@@ -32,6 +32,11 @@ type validation_result = {
       operations whose 'branch' is older than 'ttl' blocks in the
       past cannot be included in the next block. *)
 
+  last_allowed_fork_level: Int32.t ;
+  (** The level of the last block for which the node might consider an
+      alternate branch. The shell should consider as invalid any
+      branch whose fork point is older than the given level *)
+
 }
 
 type quota = {

src/lib_protocol_environment/tezos_protocol_environment.ml

@@ -37,6 +37,7 @@ module Make (Context : CONTEXT) = struct
     message: string option ;
     max_operation_data_length: int ;
     max_operations_ttl: int ;
+    last_allowed_fork_level: Int32.t ;
   }
 
   type quota = {
@@ -410,6 +411,7 @@ module Make (Context : CONTEXT) = struct
         message: string option ;
         max_operation_data_length: int ;
         max_operations_ttl: int ;
+        last_allowed_fork_level: Int32.t ;
       }
 
       type nonrec quota = quota = {

src/lib_protocol_environment/tezos_protocol_environment.mli

@@ -30,6 +30,7 @@ module Make (Context : CONTEXT) : sig
     message: string option ;
     max_operation_data_length: int ;
     max_operations_ttl: int ;
+    last_allowed_fork_level: Int32.t ;
   }
 
   type quota = {

src/lib_shell/test/test_locator.ml

@@ -95,6 +95,7 @@ let make_empty_chain (chain:State.Chain.t) n : Block_hash.t Lwt.t =
     message = None ;
     max_operation_data_length = 0 ;
     max_operations_ttl = 0 ;
+    last_allowed_fork_level = 0l ;
   } in
   let rec loop lvl pred =
     if lvl >= n then

src/proto_alpha/lib_protocol/src/alpha_context.ml

@@ -98,6 +98,8 @@ let finalize ?commit_message:message c =
   let constants = Raw_context.constants c in
   { Updater.context ; fitness ; message ; max_operations_ttl = 60 ;
     max_operation_data_length = constants.max_operation_data_length ;
+    last_allowed_fork_level =
+      Raw_level.to_int32 @@ Level.last_allowed_fork_level c;
   }
 
 let configure_sandbox = Raw_context.configure_sandbox

src/proto_alpha/lib_protocol/src/alpha_context.mli

@@ -327,6 +327,8 @@ module Level : sig
   val last_level_in_cycle: context -> Cycle.t -> level
   val levels_in_cycle: context -> Cycle.t -> level list
 
+  val last_allowed_fork_level: context -> Raw_level.t
+
 end
 
 module Fitness : sig

src/proto_alpha/lib_protocol/src/level_storage.ml

@@ -77,3 +77,11 @@ let levels_with_commitments_in_cycle ctxt c =
     else acc
   in
   loop first []
+
+
+let last_allowed_fork_level c =
+  let level = Raw_context.current_level c in
+  let preserved_cycles = Constants_storage.preserved_cycles c in
+  match Cycle_repr.sub level.cycle preserved_cycles with
+  | None -> Raw_level_repr.root
+  | Some cycle -> (first_level_in_cycle c cycle).level

src/proto_alpha/lib_protocol/src/level_storage.mli

@@ -16,8 +16,11 @@ val from_raw: Raw_context.t -> ?offset:int32 -> Raw_level_repr.t -> Level_repr.t
 val pred: Raw_context.t -> Level_repr.t -> Level_repr.t option
 val succ: Raw_context.t -> Level_repr.t -> Level_repr.t
 
+val first_level_in_cycle: Raw_context.t -> Cycle_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
+
+val last_allowed_fork_level: Raw_context.t -> Raw_level_repr.t

src/proto_demo/lib_protocol/src/main.ml

@@ -89,7 +89,8 @@ let finalize_block ctxt =
   let message = Some (Format.asprintf "fitness <- %Ld" fitness) in
   let fitness = Fitness.from_int64 fitness in
   return { Updater.message ; context = ctxt.context ; fitness ;
-           max_operations_ttl = 0 ; max_operation_data_length = 0 }
+           max_operations_ttl = 0 ; max_operation_data_length = 0 ;
+           last_allowed_fork_level = 0l }
 
 let rpc_services = Services.rpc_services
 

src/proto_genesis/lib_protocol/src/main.ml

@@ -82,7 +82,7 @@ let precheck_block
   Lwt.return (parse_block raw_block) >>=? fun _ ->
   return ()
 
-let prepare_application ctxt command timestamp fitness =
+let prepare_application ctxt command level timestamp fitness =
   match command with
   | Data.Command.Activate { protocol = hash ; fitness } ->
       let message =
@@ -90,7 +90,8 @@ let prepare_application ctxt command timestamp fitness =
       Updater.activate ctxt hash >>= fun ctxt ->
       return { Updater.message ; context = ctxt ;
                fitness ; max_operations_ttl = 0 ;
-               max_operation_data_length = 0 }
+               max_operation_data_length = 0 ;
+               last_allowed_fork_level = level }
   | Activate_testchain { protocol = hash ; delay } ->
       let message =
         Some (Format.asprintf "activate testchain %a" Protocol_hash.pp_short hash) in
@@ -98,7 +99,9 @@ let prepare_application ctxt command timestamp fitness =
       Updater.fork_test_chain ctxt ~protocol:hash ~expiration >>= fun ctxt ->
       return { Updater.message ; context = ctxt ; fitness ;
                max_operations_ttl = 0 ;
-               max_operation_data_length = 0 }
+               max_operation_data_length = 0 ;
+               last_allowed_fork_level = Int32.succ level ;
+             }
 
 
 let begin_application
@@ -109,12 +112,13 @@ let begin_application
   Data.Init.may_initialize ctxt >>=? fun ctxt ->
   Lwt.return (parse_block raw_block) >>=? fun block ->
   check_signature ctxt block >>=? fun () ->
-  prepare_application ctxt block.command block.shell.timestamp block.shell.fitness
+  prepare_application ctxt block.command
+    block.shell.level block.shell.timestamp block.shell.fitness
 
 let begin_construction
     ~predecessor_context:ctxt
     ~predecessor_timestamp:_
-    ~predecessor_level:_
+    ~predecessor_level:level
     ~predecessor_fitness:fitness
     ~predecessor:_
     ~timestamp
@@ -126,13 +130,14 @@ let begin_construction
       return { Updater.message = None ; context = ctxt ;
                fitness ; max_operations_ttl = 0 ;
                max_operation_data_length = 0 ;
+               last_allowed_fork_level = 0l ;
              }
   | Some command ->
       match Data_encoding.Binary.of_bytes Data.Command.encoding command with
       | None -> failwith "Failed to parse proto header"
       | Some command ->
           Data.Init.may_initialize ctxt >>=? fun ctxt ->
-          prepare_application ctxt command timestamp fitness
+          prepare_application ctxt command level timestamp fitness
 
 let apply_operation _vctxt _ =
   Lwt.return (Error []) (* absurd *)