Alpha: increment version string and update context stitching

src/proto_alpha/lib_protocol/src/init_storage.ml

@@ -43,29 +43,44 @@ 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 ->
+  | Alpha_002 ->
-      Storage.Contract.fold ctxt ~init:(ok ctxt)
+      Storage.Delegates.fold ctxt ~init:(Ok ctxt) ~f:begin fun delegate ctxt ->
-        ~f:(fun contract ctxt ->
+        Lwt.return ctxt >>=? fun ctxt ->
-            Lwt.return ctxt >>=? fun ctxt ->
+        Storage.Contract.Inactive_delegate.mem ctxt
-            match contract with
+          (Contract_repr.implicit_contract delegate) >>= fun inactive ->
-            | Implicit _ -> return ctxt
+        if inactive then
-            | Originated _contract_hash ->
+          return ctxt
-                Roll_storage.get_contract_delegate ctxt contract >>=? fun delegate ->
+        else
-                match delegate with
+          Storage.Roll.Delegate_roll_list.get_option ctxt delegate >>=? function
-                | None -> return ctxt
+          | None ->
-                | Some delegate ->
+              return ctxt
-                    Delegate_storage.registered ctxt delegate >>= fun registered ->
+          | Some _ ->
-                    if registered then
+              Storage.Active_delegates_with_rolls.add ctxt delegate >>= fun ctxt ->
-                      return ctxt
+              return ctxt
-                    else
+      end >>=? fun ctxt ->
-                      Contract_storage.is_manager_key_revealed
+      let { Level_repr.cycle = current_cycle } = Raw_context.current_level ctxt in
-                        ctxt (Contract_repr.implicit_contract delegate) >>=? fun revealed ->
+      let { Constants_repr.preserved_cycles } = Raw_context.constants ctxt in
-                      if revealed then
+      let first_cycle =
-                        Delegate_storage.set ctxt
+        match Cycle_repr.sub current_cycle preserved_cycles with
-                          (Contract_repr.implicit_contract delegate)
+        | None -> Cycle_repr.root
-                          (Some delegate)
+        | Some first_cycle -> first_cycle in
-                      else
+      Storage.Delegates.fold ctxt ~init:(Ok ctxt) ~f:begin fun delegate ctxt ->
-                        return ctxt)
+        Lwt.return ctxt >>=? fun ctxt ->
+        let rec loop ctxt cycle =
+          if Cycle_repr.(cycle > current_cycle) then
+            return ctxt
+          else
+            Delegate_storage.has_frozen_balance ctxt delegate cycle >>=? fun has_frozen_balance ->
+            begin
+              if has_frozen_balance then
+                Storage.Delegates_with_frozen_balance.add (ctxt, cycle) delegate
+              else
+                Lwt.return ctxt
+            end >>= fun ctxt ->
+            loop ctxt (Cycle_repr.succ cycle) in
+        loop ctxt first_cycle
+      end >>=? fun ctxt ->
+      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_002"
+let version_value = "alpha_003"
 
 let version = "v1"
 let first_level_key = [ version ; "first_level" ]
@@ -450,7 +450,7 @@ let prepare ~level ~timestamp ~fitness ctxt =
 
 type 'a previous_protocol =
   | Genesis of 'a
-  | Alpha
+  | Alpha_002
 
 let check_first_block ctxt =
   Context.get ctxt version_key >>= function
@@ -462,8 +462,8 @@ let check_first_block ctxt =
         failwith "Internal error: previously initialized context."
       else if Compare.String.(s = "genesis") then
         return (Genesis ())
-      else if Compare.String.(s = "alpha") then
+      else if Compare.String.(s = "alpha_002") then
-        return Alpha
+        return Alpha_002
       else
         storage_error (Incompatible_protocol_version s)
 
@@ -476,8 +476,8 @@ let prepare_first_block ~level ~timestamp ~fitness ctxt =
         set_first_level ctxt first_level >>=? fun ctxt ->
         set_constants ctxt param.constants >>= fun ctxt ->
         return (Genesis param, ctxt)
-    | Alpha ->
+    | Alpha_002 ->
-        return (Alpha, ctxt)
+        return (Alpha_002, ctxt)
   end >>=? fun (previous_proto, ctxt) ->
   Context.set ctxt version_key
     (MBytes.of_string version_value) >>= fun ctxt ->

src/proto_alpha/lib_protocol/src/raw_context.mli

@@ -60,7 +60,7 @@ val prepare:
 
 type 'a previous_protocol =
   | Genesis of 'a
-  | Alpha
+  | Alpha_002
 
 val prepare_first_block:
   level:int32 ->