Alpha_002: prepare for Proto_alpha upgrade

src/bin_client/test/test_basic.sh

@@ -13,7 +13,7 @@ $client -w none config update
 sleep 2
 
 #tests for the rpc service raw_context
-$client rpc get '/chains/main/blocks/head/context/raw/bytes/version' | assert '"616c706861"'
+$client rpc get '/chains/main/blocks/head/context/raw/bytes/version' | assert '"616c7068615f303032"'
 $client rpc get '/chains/main/blocks/head/context/raw/bytes/non-existent' | assert 'No service found at this URL'
 $client rpc get '/chains/main/blocks/head/context/raw/bytes/delegates/?depth=3' | assert '{ "ed25519":
     { "02": { "29": null }, "a9": { "ce": null }, "c5": { "5c": null },

src/proto_alpha/lib_delegate/test/test_rpc.ml

@@ -42,7 +42,7 @@ let run blkid =
   in
 
   (* files and directories that are in context *)
-  let version = Key (MBytes.of_hex (`Hex "616c706861")) in
+  let version = Key (MBytes.of_hex (`Hex "616c7068615f303032")) in
   let dir_depth0 = Cut in
   let dir_depth2 = Dir [("02", Dir [("29", Cut)]);
                         ("a9", Dir [("ce", Cut)]);

src/proto_alpha/lib_protocol/src/init_storage.ml

@@ -26,7 +26,9 @@
 (* This is the genesis protocol: initialise the state *)
 let prepare_first_block ctxt ~typecheck ~level ~timestamp ~fitness =
   Raw_context.prepare_first_block
-    ~level ~timestamp ~fitness ctxt >>=? fun (param, ctxt) ->
+    ~level ~timestamp ~fitness ctxt >>=? fun (previous_protocol, ctxt) ->
+  match previous_protocol with
+  | Genesis param ->
       Commitment_storage.init ctxt param.commitments >>=? fun ctxt ->
       Roll_storage.init ctxt >>=? fun ctxt ->
       Seed_storage.init ctxt >>=? fun ctxt ->
@@ -41,6 +43,8 @@ let prepare_first_block ctxt ~typecheck ~level ~timestamp ~fitness =
       Vote_storage.init ctxt >>=? fun ctxt ->
       Storage.Last_block_priority.init ctxt 0 >>=? fun ctxt ->
       return ctxt
+  | Alpha ->
+      return ctxt
 
 let prepare ctxt ~level ~timestamp ~fitness =
   Raw_context.prepare ~level ~timestamp ~fitness ctxt

src/proto_alpha/lib_protocol/src/raw_context.ml

@@ -307,7 +307,7 @@ let storage_error err = fail (Storage_error err)
 (* 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"
+let version_value = "alpha_002"
 
 let version = "v1"
 let first_level_key = [ version ; "first_level" ]
@@ -448,28 +448,41 @@ let prepare ~level ~timestamp ~fitness ctxt =
     internal_nonces_used = Int_set.empty ;
   }
 
+type 'a previous_protocol =
+  | Genesis of 'a
+  | Alpha
+
 let check_first_block ctxt =
   Context.get ctxt version_key >>= function
-  | None -> return_unit
+  | None ->
+      failwith "Internal error: un-initialized context in check_first_block."
   | Some bytes ->
       let s = MBytes.to_string bytes in
       if Compare.String.(s = version_value) then
         failwith "Internal error: previously initialized context."
       else if Compare.String.(s = "genesis") then
-        return_unit
+        return (Genesis ())
+      else if Compare.String.(s = "alpha") then
+        return Alpha
       else
         storage_error (Incompatible_protocol_version s)
 
 let prepare_first_block ~level ~timestamp ~fitness ctxt =
-  check_first_block ctxt >>=? fun () ->
+  check_first_block ctxt >>=? fun previous_protocol ->
+  begin match previous_protocol with
+    | Genesis () ->
         Lwt.return (Raw_level_repr.of_int32 level) >>=? fun first_level ->
         get_proto_param ctxt >>=? fun (param, ctxt) ->
-  Context.set ctxt version_key
-    (MBytes.of_string version_value) >>= fun ctxt ->
         set_first_level ctxt first_level >>=? fun ctxt ->
         set_constants ctxt param.constants >>= fun ctxt ->
+        return (Genesis param, ctxt)
+    | Alpha ->
+        return (Alpha, ctxt)
+  end >>=? fun (previous_proto, ctxt) ->
+  Context.set ctxt version_key
+    (MBytes.of_string version_value) >>= fun ctxt ->
   prepare ctxt ~level ~timestamp ~fitness >>=? fun ctxt ->
-  return (param, ctxt)
+  return (previous_proto, ctxt)
 
 let activate ({ context = c ; _ } as s) h =
   Updater.activate c h >>= fun c -> Lwt.return { s with context = c }

src/proto_alpha/lib_protocol/src/raw_context.mli

@@ -58,11 +58,15 @@ val prepare:
   fitness: Fitness.t ->
   Context.t -> context tzresult Lwt.t
 
+type 'a previous_protocol =
+  | Genesis of 'a
+  | Alpha
+
 val prepare_first_block:
   level:int32 ->
   timestamp:Time.t ->
   fitness:Fitness.t ->
-  Context.t -> (Parameters_repr.t * context) tzresult Lwt.t
+  Context.t -> (Parameters_repr.t previous_protocol * context) tzresult Lwt.t
 
 val activate: context -> Protocol_hash.t -> t Lwt.t
 val fork_test_chain: context -> Protocol_hash.t -> Time.t -> t Lwt.t

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

@@ -222,7 +222,10 @@ let initial_context
     Data_encoding.Binary.to_bytes_exn Data_encoding.json json
   in
   Tezos_protocol_environment_memory.Context.(
-    set empty protocol_param_key proto_params
+    set empty ["version"] (MBytes.of_string "genesis")
+  ) >>= fun ctxt ->
+  Tezos_protocol_environment_memory.Context.(
+    set ctxt protocol_param_key proto_params
   ) >>= fun ctxt ->
   Main.init ctxt header
   >|= Alpha_environment.wrap_error >>=? fun { context; _ } ->