Small package of fixes for migration process

src/app/berkeley_migration/berkeley_migration.ml

@@ -75,7 +75,8 @@ let internal_commands_from_block_id ~mainnet_pool block_id =
         internal_cmd.fee |> Unsigned.UInt64.of_int64 |> Currency.Fee.of_uint64
       in
       let hash =
-        Mina_transaction.Transaction_hash.of_base58_check_exn internal_cmd.hash
+        Mina_transaction.Transaction_hash.of_base58_check_exn_v1
+          internal_cmd.hash
       in
       let status = "applied" in
       let failure_reason = None in
@@ -142,7 +143,7 @@ let user_commands_from_block_id ~mainnet_pool block_id =
           ~f:mainnet_transaction_failure_of_string
       in
       let hash =
-        Mina_transaction.Transaction_hash.of_base58_check_exn user_cmd.hash
+        Mina_transaction.Transaction_hash.of_base58_check_exn_v1 user_cmd.hash
       in
       let cmd : Archive_lib.Extensional.User_command.t =
         { sequence_no
@@ -184,7 +185,8 @@ let mainnet_protocol_version =
   Protocol_version.create ~transaction:1 ~network:0 ~patch:0
 
 let mainnet_block_to_extensional ~logger ~mainnet_pool
-    ~(genesis_block : Mina_block.t) (block : Sql.Mainnet.Block.t) =
+    ~(genesis_block : Mina_block.t) (block : Sql.Mainnet.Block.t) ~bucket
+    ~batch_size =
   let query_mainnet_db ~f = Mina_caqti.query ~f mainnet_pool in
   let is_genesis_block = Int64.equal block.height Int64.one in
   let genesis_consensus_state =
@@ -199,7 +201,7 @@ let mainnet_block_to_extensional ~logger ~mainnet_pool
     (* we may try to be fetching more blocks than exist
        gsutil seems to get the ones that do exist, in that exist
     *)
-    let batch_size = 1000L in
+    let batch_size = Int64.of_int batch_size in
     if is_genesis_block then Deferred.unit
     else if !first_batch then (
       let num_blocks = Int64.(batch_size - (block.height % batch_size)) in
@@ -209,7 +211,7 @@ let mainnet_block_to_extensional ~logger ~mainnet_pool
           ; ("num_blocks", `Int (Int64.to_int_exn num_blocks))
           ] ;
       let%bind () =
-        Precomputed_block.fetch_batch ~height:block.height ~num_blocks
+        Precomputed_block.fetch_batch ~height:block.height ~num_blocks ~bucket
       in
       [%log info] "Done fetching first batch of precomputed blocks" ;
       first_batch := false ;
@@ -224,7 +226,7 @@ let mainnet_block_to_extensional ~logger ~mainnet_pool
           ] ;
       let%bind () =
         Precomputed_block.fetch_batch ~height:block.height
-          ~num_blocks:batch_size
+          ~num_blocks:batch_size ~bucket
       in
       [%log info] "Done fetching batch of precomputed blocks" ;
       Deferred.unit )
@@ -403,7 +405,7 @@ let mainnet_block_to_extensional ~logger ~mainnet_pool
       : Archive_lib.Extensional.Block.t )
 
 let main ~mainnet_archive_uri ~migrated_archive_uri ~runtime_config_file
-    ~end_global_slot () =
+    ~end_global_slot ~mina_network_blocks_bucket ~batch_size () =
   let logger = Logger.create () in
   let mainnet_archive_uri = Uri.of_string mainnet_archive_uri in
   let migrated_archive_uri = Uri.of_string migrated_archive_uri in
@@ -500,7 +502,7 @@ let main ~mainnet_archive_uri ~migrated_archive_uri ~runtime_config_file
               block.height block.state_hash ;
             let%bind extensional_block =
               mainnet_block_to_extensional ~logger ~mainnet_pool ~genesis_block
-                block
+                block ~bucket:mina_network_blocks_bucket ~batch_size
             in
             query_migrated_db ~f:(fun db ->
                 match%map
@@ -546,6 +548,15 @@ let () =
              ~doc:
                "NN Last global slot since genesis to include in the migration \
                 (if omitted, only canonical blocks will be migrated)"
+         and mina_network_blocks_bucket =
+           Param.flag "--mainnet-blocks-bucket"
+             ~aliases:[ "-mainnet-blocks-bucket" ]
+             Param.(required string)
+             ~doc:"Bucket with precomputed mainnet blocks"
+         and batch_size =
+           Param.flag "--batch-size" ~aliases:[ "-batch-size" ]
+             Param.(required int)
+             ~doc:"Batch size used when downloading precomputed blocks"
          in
          main ~mainnet_archive_uri ~migrated_archive_uri ~runtime_config_file
-           ~end_global_slot )))
+           ~end_global_slot ~mina_network_blocks_bucket ~batch_size )))

src/app/berkeley_migration/precomputed_block.ml

@@ -23,11 +23,10 @@ let make_batch_args ~height ~num_blocks =
   List.init (Int64.to_int_exn actual_num_blocks) ~f:(fun n ->
       sprintf "mainnet-%Ld-*.json" Int64.(start_height + Int64.of_int n) )
 
-let fetch_batch ~height ~num_blocks =
+let fetch_batch ~height ~num_blocks ~bucket =
   let batch_args = make_batch_args ~height ~num_blocks in
   let block_uris =
-    List.map batch_args ~f:(fun arg ->
-        sprintf "gs://mina_network_block_data/%s" arg )
+    List.map batch_args ~f:(fun arg -> sprintf "gs://%s/%s" bucket arg)
   in
   match%map
     Process.run ~prog:"gsutil" ~args:([ "-m"; "cp" ] @ block_uris @ [ "." ]) ()
@@ -48,12 +47,14 @@ let delete_fetched () : unit Deferred.t =
     Array.filter files ~f:(fun file -> Str.string_match block_re file 0)
   in
   let args = Array.to_list block_files in
-  match%map Process.run ~prog:"rm" ~args () with
-  | Ok _ ->
-      ()
-  | Error err ->
-      failwithf "Could not delete fetched precomputed blocks, error %s"
-        (Error.to_string_hum err) ()
+  if List.length args > 0 then
+    match%map Process.run ~prog:"rm" ~args () with
+    | Ok _ ->
+        ()
+    | Error err ->
+        failwithf "Could not delete fetched precomputed blocks, error %s"
+          (Error.to_string_hum err) ()
+  else Deferred.unit
 
 let get_json_item filter ~state_hash ~height =
   let target = make_target ~state_hash ~height in

src/lib/base58_check/version_bytes.ml

@@ -34,7 +34,8 @@ let state_hash : t = '\x10'
 
 let state_body_hash : t = '\x11'
 
-(* don't use \x12, which was for pre-Berkeley hard fork transaction hashes *)
+(* original mainnet transaction hashes *)
+let v1_transaction_hash : t = '\x12'
 
 (* used only to deserialize transaction ids, pre-Berkeley hard fork *)
 let signed_command_v1 : t = '\x13'

src/lib/blake2/blake2.ml

@@ -52,6 +52,12 @@ module Make () = struct
 
   [%%versioned_binable
   module Stable = struct
+    (* it would be better to use `with_all_version_tags` on just
+       the module where we need a version tag, but that doesn't
+       (yet) work with %%versioned_binable
+    *)
+    [@@@with_top_version_tag]
+
     module V1 = struct
       type t = T1.t [@@deriving hash, sexp, compare, equal]
 

src/lib/blake2/intf.ml

@@ -7,6 +7,11 @@ module type S = sig
 
   [%%versioned:
   module Stable : sig
+    (* generate `With_top_version_tag` modules for compatibility
+       used for original mainnet transaction hashes
+    *)
+    [@@@with_top_version_tag]
+
     module V1 : sig
       type t [@@deriving sexp, compare, hash, equal, yojson]
     end

src/lib/transaction/transaction_hash.ml

@@ -9,6 +9,23 @@ end
 
 include T
 
+(* Base58Check functions for original mainnet transaction hashes *)
+module V1_base58_check = Codable.Make_base58_check (struct
+  (* top tag needed for compatibility *)
+  type t = Stable.Latest.With_top_version_tag.t [@@deriving bin_io_unversioned]
+
+  let version_byte = Base58_check.Version_bytes.v1_transaction_hash
+
+  let description = "V1 Transaction hash"
+end)
+
+let to_base58_check_v1 = V1_base58_check.to_base58_check
+
+let of_base58_check_v1 = V1_base58_check.of_base58_check
+
+let of_base58_check_exn_v1 = V1_base58_check.of_base58_check_exn
+
+(* Base58Check functions for current hard fork *)
 module Base58_check = Codable.Make_base58_check (struct
   type t = Stable.Latest.t [@@deriving bin_io_unversioned]
 
@@ -241,6 +258,17 @@ let%test_module "Transaction hashes" =
       in
       String.equal hash expected_hash
 
+    let%test "decode, recode v1 hashes" =
+      let v1_hashes =
+        [ "CkpZirFuoLVVab6x2ry4j8Ld5gMmQdak7VHW6f5C7VJYE34WAEWqa"
+        ; "CkpZB4WE3wDRJ4CqCXqS4dqF8hoRQDVK8banePKUgTR6kvhTfyjRp"
+        ; "CkpYeG32dVJUjs6iq3oroXWitXar1eBtV3GVFyH5agw7HPp9bG4yQ"
+        ]
+      in
+      let decoded = List.map v1_hashes ~f:of_base58_check_exn_v1 in
+      let recoded = List.map decoded ~f:to_base58_check_v1 in
+      List.equal String.equal v1_hashes recoded
+
     let%test "signed command v1 hash from transaction id" =
       let transaction_id =
         "BD421DxjdoLimeUh4RA4FEvHdDn6bfxyMVWiWUwbYzQkqhNUv8B5M4gCSREpu9mVueBYoHYWkwB8BMf6iS2jjV8FffvPGkuNeczBfY7YRwLuUGBRCQJ3ktFBrNuu4abqgkYhXmcS2xyzoSGxHbXkJRAokTwjQ9HP6TLSeXz9qa92nJaTeccMnkoZBmEitsZWWnTCMqDc6rhN4Z9UMpg4wzdPMwNJvLRuJBD14Dd5pR84KBoY9rrnv66rHPc4m2hH9QSEt4aEJC76BQ446pHN9ZLmyhrk28f5xZdBmYxp3hV13fJEJ3Gv1XqJMBqFxRhzCVGoKDbLAaNRb5F1u1WxTzJu5n4cMMDEYydGEpNirY2PKQqHkR8gEqjXRTkpZzP8G19qT"

src/lib/transaction/transaction_hash.mli

@@ -20,6 +20,13 @@ val of_base58_check_exn : string -> t
 
 val to_base58_check : t -> string
 
+(* original mainnet transaction hashes *)
+val to_base58_check_v1 : t -> string
+
+val of_base58_check_v1 : string -> t Or_error.t
+
+val of_base58_check_exn_v1 : string -> t
+
 val hash_signed_command : Signed_command.t -> t
 
 val hash_signed_command_v1 : Signed_command.Stable.V1.t -> t