Large random parallel block storage test

deku-p/src/core/block_storage/tests/block_storage_tests.ml

@@ -138,9 +138,8 @@ let test_200k_block_load env () =
     in
 
     Alcotest.(check' block_testable)
-      ~msg:"level loaded 200k block is equal to saved block" ~expected:block
+      ~msg:"level loaded block is equal to saved block" ~expected:block
       ~actual:retrieved_block;
-
     Eio.Switch.fail sw Test_finished
   with _ -> ()
 
@@ -176,7 +175,7 @@ let test_200k_block_and_votes env () =
       | None -> default_return
     in
     Alcotest.(check' (pair block_testable (list vote_testable)))
-      ~msg:"retrieved 200k block and one vote equal saved"
+      ~msg:"retrieved empty block and one vote equal saved"
       ~expected:(block, votes) ~actual:retrieved_block_and_votes;
 
     Eio.Switch.fail sw Test_finished
@@ -227,12 +226,25 @@ let test_ordered_parallel_read_write env () =
     Eio.Switch.fail sw Test_finished
   with _ -> ()
 
+let test_extreme_parallel_read_write env () =
+  try
+    Parallel.Pool.run ~env ~domains:6 @@ fun () ->
+    Eio.Switch.run @@ fun sw ->
+    let calls = 100 in
+    let block_storage = make_block_storage env sw in
+    let thunk_list = Generative.build_random_list (calls / 2) block_storage in
+    List.iter
+      (fun f -> Eio.Fiber.fork ~sw (Parallel.parallel (fun () -> f ())))
+      thunk_list;
+    Eio.Switch.fail sw Test_finished
+  with _ -> ()
+
 let run () =
   Eio_main.run (fun env ->
       let open Alcotest in
       run "Block_storage" ~and_exit:false
         [
-          ( "block storage",
+          ( "simple",
             [
               test_case "empty_block is returned" `Quick
                 (test_empty_block_load env);
@@ -244,12 +256,9 @@ let run () =
                 (test_200k_block_and_votes env);
               test_case "parallel read and write" `Quick
                 (test_ordered_parallel_read_write env);
+              test_case "parallel extreme read and write" `Quick
+                (test_extreme_parallel_read_write env);
             ] );
         ])
 
 let () = run ()
-
-(* TODO: Tests
-   try all combinations of what's in the block_storage.mli. Use it with different block sizes, do it in parallel, try reading and writing at the same time, try reading a query that doesn't exist
-   try reading something right before you write it and vice versa,
-   try reading or writing two things at once *)

deku-p/src/core/block_storage/tests/generative.ml

@@ -0,0 +1,80 @@
+open Deku_stdlib
+open Deku_crypto
+open Deku_consensus
+open Deku_concepts
+
+let block_testable = Alcotest.testable Block.pp Block.equal
+
+let identity =
+  let secret = Ed25519.Secret.generate () in
+  let secret = Secret.Ed25519 secret in
+  Identity.make secret
+
+let block ?(above = Genesis.block) ~default_block_size () =
+  let withdrawal_handles_hash =
+    let randn = Stdlib.Random.int 230 in
+    Deku_crypto.BLAKE2b.hash (Int.to_string randn)
+  in
+  let producer = Producer.empty in
+  Producer.produce ~identity ~default_block_size ~above ~withdrawal_handles_hash
+    producer
+
+let get_from n l =
+  let rec find index prev =
+    match l with
+    | hd :: tl -> (
+        match index = 0 with
+        | true -> (hd, prev @ tl)
+        | false -> find (index - 1) (hd :: prev))
+    | [] -> failwith "index out of range"
+  in
+  find n []
+
+let blocks count =
+  let i = List.init count Fun.id in
+  List.fold_left
+    (fun (above, blocks) i ->
+      let b = block ~above ~default_block_size:0 () in
+      (b, (i, b) :: blocks))
+    (Genesis.block, []) i
+
+let writer_reader (index, (Block { hash; _ } as block : Block.t)) block_storage
+    =
+  let written = Atomic.make false in
+  let writer () =
+    Atomic.set written true;
+    Deku_block_storage.Block_storage.save_block ~block block_storage
+  in
+  let reader () =
+    let retrieved_block =
+      match Atomic.get written with
+      | true -> 
+            Deku_block_storage.Block_storage.find_block_by_hash ~block_hash:hash
+              block_storage
+      | false -> None
+    in
+    let expected =
+      match Atomic.get written with true -> Some block | false -> None
+    in
+    Alcotest.(check' (option block_testable))
+      ~msg:
+        (Format.sprintf "block %d was written and read successfully in parallel"
+           index)
+      ~expected ~actual:retrieved_block
+  in
+  [ writer; reader ]
+
+let build_random_list count block_storage =
+  let _, blocks = blocks count in
+  let thunks =
+    List.map (fun block -> writer_reader block block_storage) blocks
+    |> List.concat
+  in
+
+  let rec build_random_list len out l =
+    let r = Stdlib.Random.int len in
+    let elt, rest = get_from r l in
+    build_random_list (len - 1) (elt :: out) rest
+  in
+
+  build_random_list count [] thunks