From fad9365693c3252daf4ac837b9272106fe379e51 Mon Sep 17 00:00:00 2001
From: Eugen Zalinescu <eugen.zalinescu@nomadic-labs.com>
Date: Tue, 11 Feb 2025 07:15:43 +0100
Subject: [PATCH 1/9] Alpha/Tests: add Block.cycle_position helper

---
 src/proto_alpha/lib_protocol/test/helpers/block.ml  | 5 +++++
 src/proto_alpha/lib_protocol/test/helpers/block.mli | 2 ++
 2 files changed, 7 insertions(+)

diff --git a/src/proto_alpha/lib_protocol/test/helpers/block.ml b/src/proto_alpha/lib_protocol/test/helpers/block.ml
index 916c28091a85..7848833a0172 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/block.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/block.ml
@@ -1312,6 +1312,11 @@ let current_cycle b =
   let current_level = b.header.shell.level in
   current_cycle_of_level ~blocks_per_cycle ~current_level
 
+let cycle_position b =
+  let blocks_per_cycle = b.constants.blocks_per_cycle in
+  let level = b.header.shell.level in
+  Int32.rem level blocks_per_cycle
+
 let first_level_of_cycle (constants : Constants.Parametric.t) ~level =
   let blocks_per_cycle = constants.blocks_per_cycle in
   Int32.(equal (rem level blocks_per_cycle) zero)
diff --git a/src/proto_alpha/lib_protocol/test/helpers/block.mli b/src/proto_alpha/lib_protocol/test/helpers/block.mli
index ceac153a4902..8b385294ab6b 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/block.mli
+++ b/src/proto_alpha/lib_protocol/test/helpers/block.mli
@@ -366,6 +366,8 @@ val current_level : block -> int32
 
 val current_cycle : block -> Cycle.t
 
+val cycle_position : block -> int32
+
 val first_level_of_cycle : Constants.Parametric.t -> level:int32 -> bool
 
 val first_block_of_cycle : block -> bool
-- 
GitLab


From 8d2b22e8b15cfd68f2b8edc29e3fffa36de3d2b8 Mon Sep 17 00:00:00 2001
From: Eugen Zalinescu <eugen.zalinescu@nomadic-labs.com>
Date: Tue, 11 Feb 2025 09:29:29 +0100
Subject: [PATCH 2/9] Alpha/Tests: use Test.fail instead of failwith

---
 .../integration/consensus/test_dal_entrapment.ml     | 12 ++++++++----
 1 file changed, 8 insertions(+), 4 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml
index 7c00e6c2acff..9020560831bb 100644
--- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml
@@ -109,7 +109,8 @@ let test_invalid_accusation_too_close_to_migration =
       when Raw_level.to_int32 level = blk.Block.header.shell.level ->
         Lwt_result_syntax.return_unit
     | errs ->
-        failwith
+        Test.fail
+          ~__LOC__
           "Error trace:@, %a does not match the expected one"
           Error_monad.pp_print_trace
           errs
@@ -126,7 +127,8 @@ let test_invalid_accusation_no_dal_content =
       when Raw_level.to_int32 level = blk.Block.header.shell.level ->
         Lwt_result_syntax.return_unit
     | errs ->
-        failwith
+        Test.fail
+          ~__LOC__
           "Error trace:@, %a does not match the expected one"
           Error_monad.pp_print_trace
           errs
@@ -143,7 +145,8 @@ let test_invalid_accusation_slot_not_attested =
       when Raw_level.to_int32 level = blk.Block.header.shell.level ->
         Lwt_result_syntax.return_unit
     | errs ->
-        failwith
+        Test.fail
+          ~__LOC__
           "Error trace:@, %a does not match the expected one"
           Error_monad.pp_print_trace
           errs
@@ -160,7 +163,8 @@ let test_invalid_accusation_slot_not_published =
       when Raw_level.to_int32 level = blk.Block.header.shell.level ->
         Lwt_result_syntax.return_unit
     | errs ->
-        failwith
+        Test.fail
+          ~__LOC__
           "Error trace:@, %a does not match the expected one"
           Error_monad.pp_print_trace
           errs
-- 
GitLab


From bd6852cfb7decfb8f0cba5ebca7f89ce40d29d6f Mon Sep 17 00:00:00 2001
From: Eugen Zalinescu <eugen.zalinescu@nomadic-labs.com>
Date: Tue, 11 Feb 2025 15:04:15 +0100
Subject: [PATCH 3/9] Alpha/Tests: use attestation level when checking the
 expected error

---
 .../consensus/test_dal_entrapment.ml          | 19 ++++++++++---------
 1 file changed, 10 insertions(+), 9 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml
index 9020560831bb..38ce0ab53edd 100644
--- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml
@@ -84,6 +84,7 @@ let test_accusation_injection ?(initial_blocks_to_bake = 2) ?expect_failure
     else None
   in
   let* attestation = Op.raw_attestation blk ?dal_content in
+  let attestation_level = blk.header.shell.level in
   let (shard, proof), _ = Seq.uncons shards_with_proofs |> Stdlib.Option.get in
   let shard_with_proof = Dal.Shard_with_proof.{shard; proof} in
   let operation =
@@ -94,19 +95,19 @@ let test_accusation_injection ?(initial_blocks_to_bake = 2) ?expect_failure
       let* _blk_final = Block.bake ~operation blk in
       return_unit
   | Some f ->
-      let expect_failure = f blk in
+      let expect_failure = f attestation_level in
       let* ctxt = Incremental.begin_construction blk in
       let* _ = Incremental.add_operation ctxt operation ~expect_failure in
       return_unit
 
 let test_invalid_accusation_too_close_to_migration =
-  let expect_failure blk = function
+  let expect_failure attestation_level = function
     | [
         Environment.Ecoproto_error
           (Validate_errors.Anonymous
            .Denunciations_not_allowed_just_after_migration {level; _});
       ]
-      when Raw_level.to_int32 level = blk.Block.header.shell.level ->
+      when Raw_level.to_int32 level = attestation_level ->
         Lwt_result_syntax.return_unit
     | errs ->
         Test.fail
@@ -118,13 +119,13 @@ let test_invalid_accusation_too_close_to_migration =
   test_accusation_injection ~initial_blocks_to_bake:1 ~expect_failure
 
 let test_invalid_accusation_no_dal_content =
-  let expect_failure blk = function
+  let expect_failure attestation_level = function
     | [
         Environment.Ecoproto_error
           (Validate_errors.Anonymous.Invalid_accusation_no_dal_content
             {level; _});
       ]
-      when Raw_level.to_int32 level = blk.Block.header.shell.level ->
+      when Raw_level.to_int32 level = attestation_level ->
         Lwt_result_syntax.return_unit
     | errs ->
         Test.fail
@@ -136,13 +137,13 @@ let test_invalid_accusation_no_dal_content =
   test_accusation_injection ~with_dal_content:false ~expect_failure
 
 let test_invalid_accusation_slot_not_attested =
-  let expect_failure blk = function
+  let expect_failure attestation_level = function
     | [
         Environment.Ecoproto_error
           (Validate_errors.Anonymous.Invalid_accusation_slot_not_attested
             {level; _});
       ]
-      when Raw_level.to_int32 level = blk.Block.header.shell.level ->
+      when Raw_level.to_int32 level = attestation_level ->
         Lwt_result_syntax.return_unit
     | errs ->
         Test.fail
@@ -154,13 +155,13 @@ let test_invalid_accusation_slot_not_attested =
   test_accusation_injection ~attest_slot:false ~expect_failure
 
 let test_invalid_accusation_slot_not_published =
-  let expect_failure blk = function
+  let expect_failure attestation_level = function
     | [
         Environment.Ecoproto_error
           (Validate_errors.Anonymous.Invalid_accusation_slot_not_published
             {level; _});
       ]
-      when Raw_level.to_int32 level = blk.Block.header.shell.level ->
+      when Raw_level.to_int32 level = attestation_level ->
         Lwt_result_syntax.return_unit
     | errs ->
         Test.fail
-- 
GitLab


From 0affa81d3219792a8103573c6f45268538123280 Mon Sep 17 00:00:00 2001
From: Eugen Zalinescu <eugen.zalinescu@nomadic-labs.com>
Date: Tue, 11 Feb 2025 07:16:31 +0100
Subject: [PATCH 4/9] Alpha/Tests: check DAL accusation inclusion time

---
 .../consensus/test_dal_entrapment.ml          | 82 +++++++++++++++++--
 1 file changed, 75 insertions(+), 7 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml
index 38ce0ab53edd..8cacf4eecfa4 100644
--- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml
@@ -20,9 +20,12 @@ open Alpha_context
 
 let commitment_and_proofs_cache = ref None
 
+type injection_time = Now | Last_valid | First_invalid
+
 (** Check various accusation operation injection scenarios. *)
-let test_accusation_injection ?(initial_blocks_to_bake = 2) ?expect_failure
-    ?(publish_slot = true) ?(with_dal_content = true) ?(attest_slot = true) () =
+let test_accusation_injection ?initial_blocks_to_bake ?expect_failure
+    ?(publish_slot = true) ?(with_dal_content = true) ?(attest_slot = true)
+    ?(inclusion_time = Now) () =
   let open Lwt_result_syntax in
   let c = Default_parameters.constants_test in
   let dal = {c.dal with incentives_enable = true; traps_fraction = Q.one} in
@@ -61,11 +64,30 @@ let test_accusation_injection ?(initial_blocks_to_bake = 2) ?expect_failure
         result
   in
   let* genesis, contract = Context.init_with_constants1 constants in
-  (* TODO: https://gitlab.com/tezos/tezos/-/issues/7686
-     We bake two blocks because we need the accusation to be introduced at level
-     at least 10 (2 = 10 - attestation_lag). In protocol S we will not need this
-     restriction. *)
-  let* blk = Block.bake_n initial_blocks_to_bake genesis in
+  let* blk =
+    let blocks_to_bake =
+      match inclusion_time with
+      | Now -> (
+          match initial_blocks_to_bake with
+          | None ->
+              (* TODO: https://gitlab.com/tezos/tezos/-/issues/7686
+                 We bake two blocks because we need the accusation to be introduced
+                 at level at least 10 (2 = 10 - attestation_lag). In protocol S we
+                 will not need this restriction. *)
+              2
+          | Some v -> v)
+      | _ ->
+          (* In this case we want the attestation to be as far as possible from
+             the accusation, so we want the attestation level to be the first
+             level of a cycle. Checking this "extreme" case ensure that slot
+             headers are not deleted too soon. *)
+          assert (Option.is_none initial_blocks_to_bake) ;
+          let blocks_per_cycle = genesis.constants.blocks_per_cycle in
+          Int32.(
+            rem (sub blocks_per_cycle (of_int lag)) blocks_per_cycle |> to_int)
+    in
+    Block.bake_n blocks_to_bake genesis
+  in
   let slot_header =
     Dal.Operations.Publish_commitment.{slot_index; commitment; commitment_proof}
   in
@@ -74,6 +96,15 @@ let test_accusation_injection ?(initial_blocks_to_bake = 2) ?expect_failure
     if publish_slot then Block.bake blk ~operation:op else Block.bake blk
   in
   let* blk = Block.bake_n (lag - 1) blk in
+  (match inclusion_time with
+  | Now -> ()
+  | _ ->
+      let position = Block.cycle_position blk |> Int32.to_int in
+      Check.(
+        (position = 0)
+          int
+          ~__LOC__
+          ~error_msg:"Expected cycle position to be 0, got %L")) ;
   let dal_content =
     if with_dal_content then
       let attestation =
@@ -90,6 +121,18 @@ let test_accusation_injection ?(initial_blocks_to_bake = 2) ?expect_failure
   let operation =
     Op.dal_entrapment (B blk) attestation slot_index shard_with_proof
   in
+  let position = Block.cycle_position blk |> Int32.to_int in
+  let blocks_to_bake =
+    let blocks_per_cycle = blk.constants.blocks_per_cycle |> Int32.to_int in
+    match inclusion_time with
+    | Now ->
+        (* bake one block such that accusation level is different from the
+           attestation level; though this does not really matter *)
+        1
+    | Last_valid -> (2 * blocks_per_cycle) - 2 - position
+    | First_invalid -> (2 * blocks_per_cycle) - 1 - position
+  in
+  let* blk = Block.bake_n blocks_to_bake blk in
   match expect_failure with
   | None ->
       let* _blk_final = Block.bake ~operation blk in
@@ -172,6 +215,23 @@ let test_invalid_accusation_slot_not_published =
   in
   test_accusation_injection ~publish_slot:false ~expect_failure
 
+let test_invalid_accusation_include_late =
+  let expect_failure attestation_level = function
+    | [
+        Environment.Ecoproto_error
+          (Validate_errors.Anonymous.Outdated_dal_denunciation {level; _});
+      ]
+      when Raw_level.to_int32 level = attestation_level ->
+        Lwt_result_syntax.return_unit
+    | errs ->
+        Test.fail
+          ~__LOC__
+          "Error trace:@, %a does not match the expected one"
+          Error_monad.pp_print_trace
+          errs
+  in
+  test_accusation_injection ~inclusion_time:First_invalid ~expect_failure
+
 let tests =
   [
     Tztest.tztest "test valid accusation" `Quick test_accusation_injection;
@@ -191,6 +251,14 @@ let tests =
       "test invalid accusation (slot_not_published)"
       `Quick
       test_invalid_accusation_slot_not_published;
+    Tztest.tztest
+      "test invalid accusation (include last)"
+      `Quick
+      (test_accusation_injection ~inclusion_time:Last_valid);
+    Tztest.tztest
+      "test invalid accusation (include late)"
+      `Quick
+      test_invalid_accusation_include_late;
   ]
 
 let () =
-- 
GitLab


From fb8323949571b86f0c45220c8b070c1240f2f4ab Mon Sep 17 00:00:00 2001
From: Eugen Zalinescu <eugen.zalinescu@nomadic-labs.com>
Date: Tue, 11 Feb 2025 09:30:31 +0100
Subject: [PATCH 5/9] Alpha/Tests: check DAL accusations cannot be included
 twice

---
 .../consensus/test_dal_entrapment.ml          | 34 +++++++++++++++----
 1 file changed, 28 insertions(+), 6 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml
index 8cacf4eecfa4..ea83b9a2dd70 100644
--- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml
@@ -133,15 +133,37 @@ let test_accusation_injection ?initial_blocks_to_bake ?expect_failure
     | First_invalid -> (2 * blocks_per_cycle) - 1 - position
   in
   let* blk = Block.bake_n blocks_to_bake blk in
-  match expect_failure with
-  | None ->
-      let* _blk_final = Block.bake ~operation blk in
-      return_unit
-  | Some f ->
-      let expect_failure = f attestation_level in
+  let* blk =
+    match expect_failure with
+    | None -> Block.bake ~operation blk
+    | Some f ->
+        let expect_failure = f attestation_level in
+        let* ctxt = Incremental.begin_construction blk in
+        let* _ = Incremental.add_operation ctxt operation ~expect_failure in
+        Incremental.finalize_block ctxt
+  in
+  (* Re-include the accusation in the following cycle and check that it is
+     rejected as a duplicate. *)
+  match (inclusion_time, expect_failure) with
+  | Now, None ->
+      let expect_failure = function
+        | [
+            Environment.Ecoproto_error
+              (Validate_errors.Anonymous.Dal_already_denounced {level; _});
+          ]
+          when Raw_level.to_int32 level = attestation_level ->
+            Lwt_result_syntax.return_unit
+        | errs ->
+            Test.fail
+              ~__LOC__
+              "Error trace:@, %a does not match the expected one"
+              Error_monad.pp_print_trace
+              errs
+      in
       let* ctxt = Incremental.begin_construction blk in
       let* _ = Incremental.add_operation ctxt operation ~expect_failure in
       return_unit
+  | _ -> return_unit
 
 let test_invalid_accusation_too_close_to_migration =
   let expect_failure attestation_level = function
-- 
GitLab


From 24ac15892d3da99843770488e25bc869c5c49d30 Mon Sep 17 00:00:00 2001
From: Eugen Zalinescu <eugen.zalinescu@nomadic-labs.com>
Date: Tue, 11 Feb 2025 10:46:18 +0100
Subject: [PATCH 6/9] Alpha/Tests: use a smaller value for traps_fraction

---
 .../consensus/test_dal_entrapment.ml          | 80 +++++++++++++++++--
 1 file changed, 73 insertions(+), 7 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml
index ea83b9a2dd70..58c6dfe9432d 100644
--- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml
@@ -22,13 +22,62 @@ let commitment_and_proofs_cache = ref None
 
 type injection_time = Now | Last_valid | First_invalid
 
+module IntMap = Map.Make (Int)
+module PkhMap = Map.Make (Signature.Public_key_hash)
+
+let get_traps_and_non_traps ~traps_fraction shard_assignment shards_with_proofs
+    =
+  List.of_seq shards_with_proofs
+  |> List.fold_left
+       (fun map (shard, proof) ->
+         let pkh_opt =
+           IntMap.find shard.Tezos_crypto_dal.Cryptobox.index shard_assignment
+         in
+         match pkh_opt with
+         | None ->
+             Test.fail
+               ~__LOC__
+               "Did not find a delegate for shard index %d"
+               shard.index
+         | Some pkh -> (
+             let res =
+               Environment.Dal.share_is_trap pkh shard.share ~traps_fraction
+             in
+             match res with
+             | Ok b ->
+                 let shard_with_proof = Dal.Shard_with_proof.{shard; proof} in
+                 let traps, not_traps =
+                   match PkhMap.find_opt pkh map with
+                   | None -> ([], [])
+                   | Some v -> v
+                 in
+                 let traps, not_traps =
+                   if b then (shard_with_proof :: traps, not_traps)
+                   else (traps, shard_with_proof :: not_traps)
+                 in
+                 PkhMap.add pkh (traps, not_traps) map
+             | Error `Decoding_error ->
+                 Test.fail ~__LOC__ "Decoding error in [share_is_trap]"))
+       PkhMap.empty
+
+let indexes_to_delegates =
+  List.fold_left
+    (fun map Plugin.RPC.Dal.S.{delegate; indexes} ->
+      List.fold_left
+        (fun map index -> IntMap.add index delegate map)
+        map
+        indexes)
+    IntMap.empty
+
 (** Check various accusation operation injection scenarios. *)
 let test_accusation_injection ?initial_blocks_to_bake ?expect_failure
     ?(publish_slot = true) ?(with_dal_content = true) ?(attest_slot = true)
     ?(inclusion_time = Now) () =
   let open Lwt_result_syntax in
   let c = Default_parameters.constants_test in
-  let dal = {c.dal with incentives_enable = true; traps_fraction = Q.one} in
+  let dal =
+    {c.dal with incentives_enable = true; traps_fraction = Q.(1 // 2)}
+  in
   let cryptobox_parameters = dal.cryptobox_parameters in
   let number_of_slots = dal.number_of_slots in
   let lag = dal.attestation_lag in
@@ -116,9 +165,26 @@ let test_accusation_injection ?initial_blocks_to_bake ?expect_failure
   in
   let* attestation = Op.raw_attestation blk ?dal_content in
   let attestation_level = blk.header.shell.level in
-  let (shard, proof), _ = Seq.uncons shards_with_proofs |> Stdlib.Option.get in
-  let shard_with_proof = Dal.Shard_with_proof.{shard; proof} in
-  let operation =
+  let* shard_assignment = Context.Dal.shards (B blk) () in
+  let indexes_to_delegates = indexes_to_delegates shard_assignment in
+  let delegate_to_shards_map =
+    get_traps_and_non_traps
+      ~traps_fraction:blk.constants.dal.traps_fraction
+      indexes_to_delegates
+      shards_with_proofs
+  in
+  let _delegate, shard_with_proof =
+    match PkhMap.min_binding_opt delegate_to_shards_map with
+    | None -> Test.fail ~__LOC__ "Unexpected case: there are no delegates"
+    | Some (pkh, ([], _not_traps)) ->
+        Test.fail
+          ~__LOC__
+          "Unexpected case: there are no traps for delegate %a"
+          Signature.Public_key_hash.pp
+          pkh
+    | Some (pkh, (shard_with_proof :: _, _not_traps)) -> (pkh, shard_with_proof)
+  in
+  let accusation =
     Op.dal_entrapment (B blk) attestation slot_index shard_with_proof
   in
   let position = Block.cycle_position blk |> Int32.to_int in
@@ -135,11 +201,11 @@ let test_accusation_injection ?initial_blocks_to_bake ?expect_failure
   let* blk = Block.bake_n blocks_to_bake blk in
   let* blk =
     match expect_failure with
-    | None -> Block.bake ~operation blk
+    | None -> Block.bake ~operation:accusation blk
     | Some f ->
         let expect_failure = f attestation_level in
         let* ctxt = Incremental.begin_construction blk in
-        let* _ = Incremental.add_operation ctxt operation ~expect_failure in
+        let* _ = Incremental.add_operation ctxt accusation ~expect_failure in
         Incremental.finalize_block ctxt
   in
   (* Re-include the accusation in the following cycle and check that it is
@@ -161,7 +227,7 @@ let test_accusation_injection ?initial_blocks_to_bake ?expect_failure
               errs
       in
       let* ctxt = Incremental.begin_construction blk in
-      let* _ = Incremental.add_operation ctxt operation ~expect_failure in
+      let* _ = Incremental.add_operation ctxt accusation ~expect_failure in
       return_unit
   | _ -> return_unit
 
-- 
GitLab


From 308d200112d9fb54acfc9e065ff12b7b8e822e3b Mon Sep 17 00:00:00 2001
From: Eugen Zalinescu <eugen.zalinescu@nomadic-labs.com>
Date: Tue, 11 Feb 2025 11:18:08 +0100
Subject: [PATCH 7/9] Alpha/Tests: add accusation check for shard is not trap

---
 .../consensus/test_dal_entrapment.ml          | 33 +++++++++++++++++--
 1 file changed, 31 insertions(+), 2 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml
index 58c6dfe9432d..2d4aeaf15f59 100644
--- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml
@@ -72,7 +72,7 @@ let indexes_to_delegates =
 (** Check various accusation operation injection scenarios. *)
 let test_accusation_injection ?initial_blocks_to_bake ?expect_failure
     ?(publish_slot = true) ?(with_dal_content = true) ?(attest_slot = true)
-    ?(inclusion_time = Now) () =
+    ?(inclusion_time = Now) ?(not_trap = false) () =
   let open Lwt_result_syntax in
   let c = Default_parameters.constants_test in
   let dal =
@@ -182,7 +182,14 @@ let test_accusation_injection ?initial_blocks_to_bake ?expect_failure
           "Unexpected case: there are no traps for delegate %a"
           Signature.Public_key_hash.pp
           pkh
-    | Some (pkh, (shard_with_proof :: _, _not_traps)) -> (pkh, shard_with_proof)
+    | Some (pkh, (_traps, [])) ->
+        Test.fail
+          ~__LOC__
+          "Unexpected case: all shards are traps for delegate %a"
+          Signature.Public_key_hash.pp
+          pkh
+    | Some (pkh, (trap_shard :: _, not_trap_shard :: _)) ->
+        if not_trap then (pkh, not_trap_shard) else (pkh, trap_shard)
   in
   let accusation =
     Op.dal_entrapment (B blk) attestation slot_index shard_with_proof
@@ -320,6 +327,24 @@ let test_invalid_accusation_include_late =
   in
   test_accusation_injection ~inclusion_time:First_invalid ~expect_failure
 
+let test_invalid_accusation_shard_is_not_trap =
+  let expect_failure attestation_level = function
+    | [
+        Environment.Ecoproto_error
+          (Validate_errors.Anonymous.Invalid_accusation_shard_is_not_trap
+            {level; _});
+      ]
+      when Raw_level.to_int32 level = attestation_level ->
+        Lwt_result_syntax.return_unit
+    | errs ->
+        Test.fail
+          ~__LOC__
+          "Error trace:@, %a does not match the expected one"
+          Error_monad.pp_print_trace
+          errs
+  in
+  test_accusation_injection ~not_trap:true ~expect_failure
+
 let tests =
   [
     Tztest.tztest "test valid accusation" `Quick test_accusation_injection;
@@ -347,6 +372,10 @@ let tests =
       "test invalid accusation (include late)"
       `Quick
       test_invalid_accusation_include_late;
+    Tztest.tztest
+      "test invalid accusation (shard is not trap)"
+      `Quick
+      test_invalid_accusation_shard_is_not_trap;
   ]
 
 let () =
-- 
GitLab


From 03d93ce5fb9d67102bd6814c67a9416d527aa076 Mon Sep 17 00:00:00 2001
From: Eugen Zalinescu <eugen.zalinescu@nomadic-labs.com>
Date: Tue, 11 Feb 2025 11:30:18 +0100
Subject: [PATCH 8/9] Alpha/Tests: check wrong shard owner in DAL accusation

---
 .../consensus/test_dal_entrapment.ml          | 77 ++++++++++++++-----
 1 file changed, 58 insertions(+), 19 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml
index 2d4aeaf15f59..a7a52b7faab6 100644
--- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml
@@ -72,12 +72,11 @@ let indexes_to_delegates =
 (** Check various accusation operation injection scenarios. *)
 let test_accusation_injection ?initial_blocks_to_bake ?expect_failure
     ?(publish_slot = true) ?(with_dal_content = true) ?(attest_slot = true)
-    ?(inclusion_time = Now) ?(not_trap = false) () =
+    ?(inclusion_time = Now) ?(not_trap = false) ?(wrong_owner = false)
+    ?(traps_fraction = Q.(1 // 2)) () =
   let open Lwt_result_syntax in
   let c = Default_parameters.constants_test in
-  let dal =
-    {c.dal with incentives_enable = true; traps_fraction = Q.(1 // 2)}
-  in
+  let dal = {c.dal with incentives_enable = true; traps_fraction} in
   let cryptobox_parameters = dal.cryptobox_parameters in
   let number_of_slots = dal.number_of_slots in
   let lag = dal.attestation_lag in
@@ -112,7 +111,9 @@ let test_accusation_injection ?initial_blocks_to_bake ?expect_failure
         commitment_and_proofs_cache := Some result ;
         result
   in
-  let* genesis, contract = Context.init_with_constants1 constants in
+  let* genesis, (contract, _contract2) =
+    Context.init_with_constants2 constants
+  in
   let* blk =
     let blocks_to_bake =
       match inclusion_time with
@@ -163,8 +164,6 @@ let test_accusation_injection ?initial_blocks_to_bake ?expect_failure
       Some {attestation}
     else None
   in
-  let* attestation = Op.raw_attestation blk ?dal_content in
-  let attestation_level = blk.header.shell.level in
   let* shard_assignment = Context.Dal.shards (B blk) () in
   let indexes_to_delegates = indexes_to_delegates shard_assignment in
   let delegate_to_shards_map =
@@ -173,23 +172,35 @@ let test_accusation_injection ?initial_blocks_to_bake ?expect_failure
       indexes_to_delegates
       shards_with_proofs
   in
-  let _delegate, shard_with_proof =
+  let delegate =
     match PkhMap.min_binding_opt delegate_to_shards_map with
     | None -> Test.fail ~__LOC__ "Unexpected case: there are no delegates"
-    | Some (pkh, ([], _not_traps)) ->
-        Test.fail
-          ~__LOC__
-          "Unexpected case: there are no traps for delegate %a"
-          Signature.Public_key_hash.pp
-          pkh
-    | Some (pkh, (_traps, [])) ->
+    | Some (pkh, _) -> pkh
+  in
+  let* attestation = Op.raw_attestation blk ~delegate ?dal_content in
+  let attestation_level = blk.header.shell.level in
+  let shard_with_proof =
+    let owner =
+      if wrong_owner then (
+        match PkhMap.max_binding delegate_to_shards_map with
+        | None -> Test.fail ~__LOC__ "Unexpected case: there are no delegates"
+        | Some (pkh, _) ->
+            if Signature.Public_key_hash.equal delegate pkh then
+              Test.fail
+                ~__LOC__
+                "Unexpected case: there should be at least two delegates" ;
+            pkh)
+      else delegate
+    in
+    match PkhMap.find owner delegate_to_shards_map with
+    | None ->
         Test.fail
           ~__LOC__
-          "Unexpected case: all shards are traps for delegate %a"
+          "Unexpected case: delegate %a not found in map"
           Signature.Public_key_hash.pp
-          pkh
-    | Some (pkh, (trap_shard :: _, not_trap_shard :: _)) ->
-        if not_trap then (pkh, not_trap_shard) else (pkh, trap_shard)
+          owner
+    | Some (traps, not_traps) ->
+        if not_trap then Stdlib.List.hd not_traps else Stdlib.List.hd traps
   in
   let accusation =
     Op.dal_entrapment (B blk) attestation slot_index shard_with_proof
@@ -345,6 +356,30 @@ let test_invalid_accusation_shard_is_not_trap =
   in
   test_accusation_injection ~not_trap:true ~expect_failure
 
+let test_invalid_accusation_wrong_shard_owner =
+  let expect_failure attestation_level = function
+    | [
+        Environment.Ecoproto_error
+          (Validate_errors.Anonymous.Invalid_accusation_wrong_shard_owner
+            {level; _});
+      ]
+      when Raw_level.to_int32 level = attestation_level ->
+        Lwt_result_syntax.return_unit
+    | errs ->
+        Test.fail
+          ~__LOC__
+          "Error trace:@, %a does not match the expected one"
+          Error_monad.pp_print_trace
+          errs
+  in
+  (* By using [traps_fraction = 1] we are sure that the shard is a trap for the
+     attester. Otherwise the validation may fail with "shard is not trap" error
+     (which is emitted first). *)
+  test_accusation_injection
+    ~wrong_owner:true
+    ~traps_fraction:Q.one
+    ~expect_failure
+
 let tests =
   [
     Tztest.tztest "test valid accusation" `Quick test_accusation_injection;
@@ -376,6 +411,10 @@ let tests =
       "test invalid accusation (shard is not trap)"
       `Quick
       test_invalid_accusation_shard_is_not_trap;
+    Tztest.tztest
+      "test invalid accusation (wrong shard owner)"
+      `Quick
+      test_invalid_accusation_wrong_shard_owner;
   ]
 
 let () =
-- 
GitLab


From c54642093671213082d572e5b1382948528e8fe9 Mon Sep 17 00:00:00 2001
From: Eugen Zalinescu <eugen.zalinescu@nomadic-labs.com>
Date: Tue, 11 Feb 2025 15:59:38 +0100
Subject: [PATCH 9/9] Alpha/Tests: describe scenario and add log messages

---
 .../consensus/test_dal_entrapment.ml          | 61 ++++++++++++++-----
 1 file changed, 47 insertions(+), 14 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml
index a7a52b7faab6..d778a74ca385 100644
--- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_dal_entrapment.ml
@@ -69,7 +69,21 @@ let indexes_to_delegates =
         indexes)
     IntMap.empty
 
-(** Check various accusation operation injection scenarios. *)
+(** This function checks various accusation operation injection scenarios.
+
+    The simplest scenario, when all optional arguments are not given, is as
+    follows:
+    1. Bake two blocks (because of #7686, see below).
+    2. Bake a block that publishes a slot.
+    3. Bake [lag - 1] blocks.
+    4. Build an attestation.
+    5. Bake one block before accusing.
+    6. Retrieve traps and build an accusation.
+    7. Bake a block with the accusation.
+
+    This scenario varies slightly depending on the optional arguments. For their
+    use, look first at the relevant tests.
+*)
 let test_accusation_injection ?initial_blocks_to_bake ?expect_failure
     ?(publish_slot = true) ?(with_dal_content = true) ?(attest_slot = true)
     ?(inclusion_time = Now) ?(not_trap = false) ?(wrong_owner = false)
@@ -136,16 +150,27 @@ let test_accusation_injection ?initial_blocks_to_bake ?expect_failure
           Int32.(
             rem (sub blocks_per_cycle (of_int lag)) blocks_per_cycle |> to_int)
     in
+    Log.info "1. Bake %d blocks" blocks_to_bake ;
     Block.bake_n blocks_to_bake genesis
   in
+
   let slot_header =
     Dal.Operations.Publish_commitment.{slot_index; commitment; commitment_proof}
   in
   let* op = Op.dal_publish_commitment (B genesis) contract slot_header in
   let* blk =
-    if publish_slot then Block.bake blk ~operation:op else Block.bake blk
+    if publish_slot then (
+      Log.info "2. Bake a block with a publish operation" ;
+      Block.bake blk ~operation:op)
+    else (
+      Log.info "2. Bake a block without a publish operation" ;
+      Block.bake blk)
   in
+
+  Log.info "3. Bake 'attestation_lag - 1' blocks" ;
   let* blk = Block.bake_n (lag - 1) blk in
+
+  Log.info "4. Build an attestation" ;
   (match inclusion_time with
   | Now -> ()
   | _ ->
@@ -179,6 +204,24 @@ let test_accusation_injection ?initial_blocks_to_bake ?expect_failure
   in
   let* attestation = Op.raw_attestation blk ~delegate ?dal_content in
   let attestation_level = blk.header.shell.level in
+
+  let* blk =
+    let blocks_to_bake =
+      let position = Block.cycle_position blk |> Int32.to_int in
+      let blocks_per_cycle = blk.constants.blocks_per_cycle |> Int32.to_int in
+      match inclusion_time with
+      | Now ->
+          (* bake one block such that accusation level is different from the
+             attestation level; though this does not really matter *)
+          1
+      | Last_valid -> (2 * blocks_per_cycle) - 2 - position
+      | First_invalid -> (2 * blocks_per_cycle) - 1 - position
+    in
+    Log.info "5. Bake %d blocks before including an accusation" blocks_to_bake ;
+    Block.bake_n blocks_to_bake blk
+  in
+
+  Log.info "6. Retrieve traps and build accusation" ;
   let shard_with_proof =
     let owner =
       if wrong_owner then (
@@ -205,18 +248,8 @@ let test_accusation_injection ?initial_blocks_to_bake ?expect_failure
   let accusation =
     Op.dal_entrapment (B blk) attestation slot_index shard_with_proof
   in
-  let position = Block.cycle_position blk |> Int32.to_int in
-  let blocks_to_bake =
-    let blocks_per_cycle = blk.constants.blocks_per_cycle |> Int32.to_int in
-    match inclusion_time with
-    | Now ->
-        (* bake one block such that accusation level is different from the
-           attestation level; though this does not really matter *)
-        1
-    | Last_valid -> (2 * blocks_per_cycle) - 2 - position
-    | First_invalid -> (2 * blocks_per_cycle) - 1 - position
-  in
-  let* blk = Block.bake_n blocks_to_bake blk in
+
+  Log.info "7. Bake a block with the accusation" ;
   let* blk =
     match expect_failure with
     | None -> Block.bake ~operation:accusation blk
-- 
GitLab