Alpha/Contracts/Migration: reindex contracts

This patch is part of the migration code from `alpha_003` to `athens_004`.

It performs the migration of contracts to the new uniform storage format.

src/proto_alpha/lib_protocol/src/contract_repr.ml

@@ -208,3 +208,15 @@ module Index = struct
   let compare = compare
 
 end
+
+let old_contract_of_path = function
+  | "originated" :: key -> begin
+      match Contract_hash.of_path key with
+      | None -> None
+      | Some h -> Some (Originated h)
+    end
+  | key -> begin
+      match Signature.Public_key_hash.of_path key with
+      | None -> None
+      | Some h -> Some (Implicit h)
+    end

src/proto_alpha/lib_protocol/src/contract_repr.mli

@@ -77,3 +77,8 @@ val origination_nonce_encoding : origination_nonce Data_encoding.t
 val rpc_arg : contract RPC_arg.arg
 
 module Index : Storage_description.INDEX with type t = t
+
+(**/**)
+
+(** Only for stitching from proto_003 to proto_004 *)
+val old_contract_of_path: string list -> contract option

src/proto_alpha/lib_protocol/src/contract_storage.ml

@@ -524,3 +524,43 @@ module Big_map = struct
   let get_opt ctxt contract key =
     Storage.Contract.Big_map.get_option (ctxt, contract) key
 end
+
+
+(* Only for stitching from proto_003 *)
+
+let fold_old_contracts ctxt ~init ~f =
+  let rec loop depth key acc =
+    if Compare.Int.(depth < 6) then
+      Raw_context.fold ctxt key ~init:(Ok acc) ~f:begin fun d acc ->
+        Lwt.return acc >>=? fun acc ->
+        match d with
+        | `Dir d -> loop (depth+1) d acc
+        | _ -> return acc (* ignore unexpected files *)
+      end
+    else
+      Raw_context.fold ctxt key ~init:(Ok acc) ~f:begin fun d acc ->
+        Lwt.return acc >>=? fun acc ->
+        match d with
+        | `Dir ( "contracts" :: "old_index" ::
+                 ([ _ ; _ ; _ ; _ ; _ ; _ ; _ ] as key) as old_path) -> begin
+            match Contract_repr.old_contract_of_path key with
+            | None -> return acc (* ignore invalid key *)
+            | Some contract -> f old_path contract acc
+          end
+        | _ -> return acc (* ignore unexpected files *)
+      end in
+  loop 0 [ "contracts" ; "old_index" ] init
+
+let reindex_contract ctxt =
+  Raw_context.copy ctxt
+    [ "contracts" ; "index" ]
+    [ "contracts" ; "old_index" ] >>=? fun ctxt ->
+  Raw_context.remove_rec ctxt [ "contracts" ; "index" ] >>= fun ctxt ->
+  fold_old_contracts ctxt ~init:ctxt ~f:begin fun old_path contract ctxt ->
+    let new_path = Contract_repr.Index.to_path contract [] in
+    Raw_context.copy ctxt
+      old_path ("contracts" :: "index" :: new_path) >>=? fun ctxt ->
+    return ctxt
+  end >>=? fun ctxt ->
+  Raw_context.remove_rec ctxt [ "contracts" ; "old_index" ] >>= fun ctxt ->
+  return ctxt

src/proto_alpha/lib_protocol/src/contract_storage.mli

@@ -138,3 +138,8 @@ module Big_map : sig
   val get_opt :
     Raw_context.t -> Contract_repr.t -> Script_expr_hash.t -> (Raw_context.t * Script_repr.expr option) tzresult Lwt.t
 end
+
+(**/**)
+
+(** Only for stitching from proto_003 to proto_004 *)
+val reindex_contract: Raw_context.t -> Raw_context.t tzresult Lwt.t

src/proto_alpha/lib_protocol/src/init_storage.ml

@@ -45,6 +45,7 @@ let prepare_first_block ctxt ~typecheck ~level ~timestamp ~fitness =
       Vote_storage.freeze_listings ctxt >>=? fun ctxt ->
       return ctxt
   | Alpha_previous ->
+      Contract_storage.reindex_contract ctxt >>=? fun ctxt ->
       (* Reallocated rolls to delegates, since rolls are now 8k tez. *)
       Roll_storage.update_tokens_per_roll ctxt
         Constants_repr.default.tokens_per_roll >>=? fun ctxt ->