Support v1 format for ledger hash generation

Problem: set_verification_key permission format was changed to include
tx_version which changed the algorithm for ledger hash verification.
This obstructs attempts to generate old-network-format hashes.

Solution: provide an option to omit tx version of set_verification_key
permission when computing the ledger hash.

Author: georgeee

src/app/runtime_genesis_ledger/runtime_genesis_ledger.ml

@@ -61,6 +61,7 @@ let load_ledger (accounts : Runtime_config.Accounts.t) =
   let packed_patched =
     Genesis_ledger_helper.Ledger.packed_genesis_ledger_of_accounts
       ~depth:migrating_from_ledger_depth
+      ~omit_set_verification_key_tx_version:true
       (lazy accounts_altered)
   in
   ( Lazy.force (Genesis_ledger.Packed.t packed)

src/lib/genesis_ledger/genesis_ledger.ml

@@ -132,7 +132,8 @@ module Make (Inputs : Intf.Ledger_input_intf) : Intf.S = struct
         |> List.mapi ~f:(fun i (_, acct) ->
                (Ledger.Addr.of_int_exn ~ledger_depth i, acct) )
       in
-      Ledger.set_batch_accounts ledger addrs_and_accounts ) ;
+      Ledger.set_batch_accounts ~omit_set_verification_key_tx_version ledger
+        addrs_and_accounts ) ;
     ledger
 
   include Utils
@@ -274,6 +275,8 @@ module Unit_test_ledger = Make (struct
   let directory = `Ephemeral
 
   let depth = Genesis_constants.Constraint_constants.for_unit_tests.ledger_depth
+
+  let omit_set_verification_key_tx_version = false
 end)
 
 let for_unit_tests : Packed.t = (module Unit_test_ledger)

src/lib/genesis_ledger/intf.ml

@@ -79,6 +79,8 @@ module type Ledger_input_intf = sig
   val directory : [ `Ephemeral | `New | `Path of string ]
 
   val depth : int
+
+  val omit_set_verification_key_tx_version : bool
 end
 
 module type S = sig

src/lib/genesis_ledger_helper/genesis_ledger_helper.ml

@@ -269,6 +269,8 @@ module Ledger = struct
             let directory = `Path dirname
 
             let depth = constraint_constants.ledger_depth
+
+            let omit_set_verification_key_tx_version = false
           end) )
       | None ->
           ( module Genesis_ledger.Of_ledger (struct
@@ -421,14 +423,18 @@ module Ledger = struct
         (Lazy.map
            ~f:(Accounts.pad_to (Option.value ~default:0 config.num_accounts)) )
 
-  let packed_genesis_ledger_of_accounts ~depth accounts :
+  let packed_genesis_ledger_of_accounts
+      ?(omit_set_verification_key_tx_version = false) ~depth accounts :
       Genesis_ledger.Packed.t =
     ( module Genesis_ledger.Make (struct
       let accounts = accounts
 
       let directory = `New
 
       let depth = depth
+
+      let omit_set_verification_key_tx_version =
+        omit_set_verification_key_tx_version
     end) )
 
   let load ~proof_level ~genesis_dir ~logger ~constraint_constants

src/lib/merkle_ledger/any_ledger.ml

@@ -134,7 +134,8 @@ module Make_base (Inputs : Inputs_intf) :
 
     let get_at_index_exn (T ((module Base), t)) = Base.get_at_index_exn t
 
-    let set_batch (T ((module Base), t)) = Base.set_batch t
+    let set_batch ?omit_set_verification_key_tx_version (T ((module Base), t)) =
+      Base.set_batch ?omit_set_verification_key_tx_version t
 
     let set (T ((module Base), t)) = Base.set t
 
@@ -188,7 +189,9 @@ module Make_base (Inputs : Inputs_intf) :
     let set_all_accounts_rooted_at_exn (T ((module Base), t)) =
       Base.set_all_accounts_rooted_at_exn t
 
-    let set_batch_accounts (T ((module Base), t)) = Base.set_batch_accounts t
+    let set_batch_accounts ?omit_set_verification_key_tx_version
+        (T ((module Base), t)) =
+      Base.set_batch_accounts ?omit_set_verification_key_tx_version t
 
     let set_inner_hash_at_addr_exn (T ((module Base), t)) =
       Base.set_inner_hash_at_addr_exn t

src/lib/merkle_ledger/base_ledger_intf.ml

@@ -117,7 +117,11 @@ module type S = sig
 
   val set : t -> Location.t -> account -> unit
 
-  val set_batch : t -> (Location.t * account) list -> unit
+  val set_batch :
+       ?omit_set_verification_key_tx_version:bool
+    -> t
+    -> (Location.t * account) list
+    -> unit
 
   val get_at_index_exn : t -> int -> account
 

src/lib/merkle_ledger/intf.ml

@@ -100,7 +100,7 @@ module type Hash = sig
 
   val merge : height:int -> t -> t -> t
 
-  val hash_account : account -> t
+  val hash_account : ?omit_set_verification_key_tx_version:bool -> account -> t
 
   val empty_account : t
 end

src/lib/merkle_ledger/null_ledger.ml

@@ -103,7 +103,8 @@ end = struct
 
   let get_at_index_exn _t = failwith "get_at_index_exn: null ledgers are empty"
 
-  let set_batch _t = failwith "set_batch: null ledgers cannot be mutated"
+  let set_batch ?omit_set_verification_key_tx_version:_ _t =
+    failwith "set_batch: null ledgers cannot be mutated"
 
   let set _t = failwith "set: null ledgers cannot be mutated"
 
@@ -165,7 +166,7 @@ end = struct
   let set_all_accounts_rooted_at_exn _t =
     failwith "set_all_accounts_rooted_at_exn: null ledgers cannot be mutated"
 
-  let set_batch_accounts _t =
+  let set_batch_accounts ?omit_set_verification_key_tx_version:_ _t =
     failwith "set_batch_accounts: null ledgers cannot be mutated"
 
   let set_inner_hash_at_addr_exn _t =

src/lib/merkle_ledger/syncable_intf.ml

@@ -23,7 +23,11 @@ module type S = sig
 
   val set_all_accounts_rooted_at_exn : t -> addr -> account list -> unit
 
-  val set_batch_accounts : t -> (addr * account) list -> unit
+  val set_batch_accounts :
+       ?omit_set_verification_key_tx_version:bool
+    -> t
+    -> (addr * account) list
+    -> unit
 
   (** Get all of the accounts that are in a subtree of the underlying Merkle
     tree rooted at `address`. The accounts are ordered by their addresses. *)

src/lib/merkle_ledger/util.ml

@@ -59,10 +59,16 @@ module Make (Inputs : Inputs_intf) : sig
     Inputs.Base.t -> (Inputs.Location.t * Inputs.Hash.t) list -> unit
 
   val set_batch :
-    Inputs.Base.t -> (Inputs.Location.t * Inputs.Account.t) list -> unit
+       ?omit_set_verification_key_tx_version:bool
+    -> Inputs.Base.t
+    -> (Inputs.Location.t * Inputs.Account.t) list
+    -> unit
 
   val set_batch_accounts :
-    Inputs.Base.t -> (Inputs.Location.Addr.t * Inputs.Account.t) list -> unit
+       ?omit_set_verification_key_tx_version:bool
+    -> Inputs.Base.t
+    -> (Inputs.Location.Addr.t * Inputs.Account.t) list
+    -> unit
 
   val set_all_accounts_rooted_at_exn :
     Inputs.Base.t -> Inputs.Location.Addr.t -> Inputs.Account.t list -> unit
@@ -188,16 +194,18 @@ end = struct
 
   (* TODO: When we do batch on a database, we should add accounts, locations and hashes
      simulatenously for full atomicity. *)
-  let set_batch t locations_and_accounts =
+  let set_batch ?omit_set_verification_key_tx_version t locations_and_accounts =
     set_raw_addresses t locations_and_accounts ;
     Inputs.set_raw_account_batch t locations_and_accounts ;
     set_hash_batch t
     @@ List.map locations_and_accounts ~f:(fun (location, account) ->
            ( Inputs.location_of_hash_addr (Inputs.Location.to_path_exn location)
-           , Inputs.Hash.hash_account account ) )
+           , Inputs.Hash.hash_account ?omit_set_verification_key_tx_version
+               account ) )
 
-  let set_batch_accounts t addresses_and_accounts =
-    set_batch t
+  let set_batch_accounts ?omit_set_verification_key_tx_version t
+      addresses_and_accounts =
+    set_batch ?omit_set_verification_key_tx_version t
     @@ List.map addresses_and_accounts ~f:(fun (addr, account) ->
            (Inputs.location_of_account_addr addr, account) )