Decomission old ledgers in test-apply

MinaProtocol · Nov 27, 2023 · fc61fa1 · fc61fa1
1 parent 5c146c4
commit fc61fa1
Show file tree

Hide file tree

Showing 2 changed files with 21 additions and 7 deletions.
diff --git a/src/app/cli/src/init/client.ml b/src/app/cli/src/init/client.ml
@@ -2252,13 +2252,16 @@ let test_ledger_application =
             (default: 3)"
          (optional int)
      and rounds =
-       flag "--rounds" ~doc:"NN Number of preparatory rounds (default: 290)"
+       flag "--rounds" ~doc:"NN Number of preparatory rounds (default: 580)"
          (optional int)
      and first_partition_slots =
        flag "--first-partition-slots"
          ~doc:
            "NN Number of slots in first partition of scan state (default: 128)"
          (optional int)
+     and max_depth =
+       flag "--max-depth" ~doc:"NN Maximum depth of masks (default: 290)"
+         (optional int)
      and no_new_stack =
        flag "--old-stack" ~doc:"Use is_new_stack: false (scan state)" no_arg
      and has_second_partition =
@@ -2271,10 +2274,11 @@ let test_ledger_application =
        Option.value ~default:128 first_partition_slots
      in
      let num_txs_per_round = Option.value ~default:3 num_txs_per_round in
-     let rounds = Option.value ~default:290 rounds in
+     let rounds = Option.value ~default:580 rounds in
+     let max_depth = Option.value ~default:290 max_depth in
      Test_ledger_application.test ~privkey_path ~ledger_path ~prev_block_path
        ~first_partition_slots ~no_new_stack ~has_second_partition
-       ~num_txs_per_round ~rounds ~no_masks num_txs )
+       ~num_txs_per_round ~rounds ~no_masks ~max_depth num_txs )
 
 let itn_create_accounts =
   Command.async ~summary:"Fund new accounts for incentivized testnet"

diff --git a/src/app/cli/src/init/test_ledger_application.ml b/src/app/cli/src/init/test_ledger_application.ml
@@ -131,7 +131,7 @@ let apply_txs ~first_partition_slots ~no_new_stack ~has_second_partition
 
 let test ~privkey_path ~ledger_path ~prev_block_path ~first_partition_slots
     ~no_new_stack ~has_second_partition ~num_txs_per_round ~rounds ~no_masks
-    num_txs_final =
+    ~max_depth num_txs_final =
   let%bind keypair = read_privkey privkey_path in
   let init_ledger =
     Ledger.create ~directory_name:ledger_path
@@ -154,7 +154,17 @@ let test ~privkey_path ~ledger_path ~prev_block_path ~first_partition_slots
       Fn.compose (Ledger.register_mask ledger)
       @@ Ledger.Mask.create ~depth:constraint_constants.ledger_depth
   in
-  Deferred.List.fold (List.init rounds ~f:ident) ~init:init_ledger
-    ~f:(fun ledger i ->
-      apply ~num_txs:num_txs_per_round ~i ledger >>| mask_handler ledger )
+  let drop_old_ledger ledger =
+    if not no_masks then (
+      Ledger.commit ledger ;
+      Ledger.remove_and_reparent_exn ledger ledger )
+  in
+  Deferred.List.fold (List.init rounds ~f:ident) ~init:(init_ledger, [])
+    ~f:(fun (ledger, ledgers) i ->
+      List.hd (List.drop ledgers (max_depth - 1))
+      |> Option.iter ~f:drop_old_ledger ;
+      apply ~num_txs:num_txs_per_round ~i ledger
+      >>| mask_handler ledger
+      >>| Fn.flip Tuple2.create (ledger :: ledgers) )
+  >>| fst
   >>= apply ~num_txs:num_txs_final ~i:rounds