From 87291e0871194c8c322bedcf51192626d5879687 Mon Sep 17 00:00:00 2001
From: Julien Coolen <julien.coolen@nomadic-labs.com>
Date: Mon, 22 May 2023 08:59:42 +0200
Subject: [PATCH] DAL/crypto: check shard length

---
 src/lib_crypto_dal/cryptobox.ml               | 27 ++++++++++-------
 src/lib_crypto_dal/cryptobox.mli              |  3 ++
 src/lib_crypto_dal/test/test_dal_cryptobox.ml | 30 +++++++++++++++++++
 3 files changed, 49 insertions(+), 11 deletions(-)

diff --git a/src/lib_crypto_dal/cryptobox.ml b/src/lib_crypto_dal/cryptobox.ml
index 0865637be5db..fcf59e60fd7c 100644
--- a/src/lib_crypto_dal/cryptobox.ml
+++ b/src/lib_crypto_dal/cryptobox.ml
@@ -1627,17 +1627,22 @@ module Inner = struct
              0
              (t.number_of_shards - 1)))
     else
-      let root =
-        Domains.get t.domain_erasure_encoded_polynomial_length shard_index
-      in
-      let domain = Domains.build t.shard_length in
-      let srs_point = t.srs.kate_amortized_srs_g2_shards in
-      match
-        verify t ~commitment ~srs_point ~domain ~root ~evaluations ~proof
-      with
-      | Ok true -> Ok ()
-      | Ok false -> Error `Invalid_shard
-      | Error e -> Error e
+      let expected_shard_length = t.shard_length in
+      let got_shard_length = Array.length evaluations in
+      if expected_shard_length <> got_shard_length then
+        Error `Shard_length_mismatch
+      else
+        let root =
+          Domains.get t.domain_erasure_encoded_polynomial_length shard_index
+        in
+        let domain = Domains.build t.shard_length in
+        let srs_point = t.srs.kate_amortized_srs_g2_shards in
+        match
+          verify t ~commitment ~srs_point ~domain ~root ~evaluations ~proof
+        with
+        | Ok true -> Ok ()
+        | Ok false -> Error `Invalid_shard
+        | Error e -> Error e
 
   let prove_page t p page_index =
     if page_index < 0 || page_index >= t.pages_per_slot then
diff --git a/src/lib_crypto_dal/cryptobox.mli b/src/lib_crypto_dal/cryptobox.mli
index 95d258c530ba..f269a3d9d72d 100644
--- a/src/lib_crypto_dal/cryptobox.mli
+++ b/src/lib_crypto_dal/cryptobox.mli
@@ -294,6 +294,8 @@ val shard_proof_encoding : shard_proof Data_encoding.t
     - [Error `Invalid_shard] if the verification fails
     - [Error `Invalid_degree_strictly_less_than_expected _] if the
     SRS contained in [t] is too small to proceed with the verification
+    - [Error `Shard_length_mismatch] if the shard is not of the expected
+    length [shard_length] given for the initialisation of [t]
     - [Error (`Shard_index_out_of_range msg)] if the shard index
     is not within the range [0, number_of_shards - 1]
     (where [number_of_shards] is found in [t]).
@@ -313,6 +315,7 @@ val verify_shard :
   ( unit,
     [> `Invalid_degree_strictly_less_than_expected of (int, int) error_container
     | `Invalid_shard
+    | `Shard_length_mismatch
     | `Shard_index_out_of_range of string ] )
   Result.t
 
diff --git a/src/lib_crypto_dal/test/test_dal_cryptobox.ml b/src/lib_crypto_dal/test/test_dal_cryptobox.ml
index 06b251a85b1a..9181b44908b2 100644
--- a/src/lib_crypto_dal/test/test_dal_cryptobox.ml
+++ b/src/lib_crypto_dal/test/test_dal_cryptobox.ml
@@ -700,6 +700,35 @@ module Test = struct
         | Error `Page_length_mismatch -> true
         | _ -> false)
 
+  let test_shard_length_mismatch =
+    let open QCheck2 in
+    let open Error_monad.Result_syntax in
+    Test.make
+      ~name:"shard_length_mismatch"
+      ~print:print_parameters
+      generate_parameters
+      (fun params ->
+        init () ;
+        assume (ensure_validity params) ;
+        (let* t = Cryptobox.make (get_cryptobox_parameters params) in
+         let state = QCheck_base_runner.random_state () in
+         let commitment =
+           Cryptobox.Internal_for_tests.dummy_commitment ~state ()
+         in
+         let length = randrange ~min:1 1000 in
+         assume (length <> Cryptobox.Internal_for_tests.shard_length t) ;
+         let index = randrange params.number_of_shards in
+         let shard =
+           Cryptobox.Internal_for_tests.make_dummy_shard ~state ~index ~length
+         in
+         let shard_proof =
+           Cryptobox.Internal_for_tests.dummy_shard_proof ~state ()
+         in
+         Cryptobox.verify_shard t commitment shard shard_proof)
+        |> function
+        | Error `Shard_length_mismatch -> true
+        | _ -> false)
+
   let test_prove_page_out_of_bounds =
     let open QCheck2 in
     let open Error_monad.Result_syntax in
@@ -968,6 +997,7 @@ let () =
             Test.test_dal_initialisation_twice_failure;
             Test.test_wrong_slot_size;
             Test.test_page_length_mismatch;
+            Test.test_shard_length_mismatch;
             Test.test_prove_page_out_of_bounds;
             Test.test_verify_page_out_of_bounds;
             Test.test_verify_shard_out_of_bounds;
-- 
GitLab