From a81a370ab6af28ab17c560d5d79f29a34411119f Mon Sep 17 00:00:00 2001 From: kwxm Date: Thu, 18 Sep 2025 08:56:01 +0100 Subject: [PATCH 1/4] Property tests for BLS12-381 multi-scalar multiplication --- .../testlib/Evaluation/Builtins/BLS12_381.hs | 107 ++++++++++++++++-- .../Builtins/BLS12_381/TestClasses.hs | 50 ++++---- 2 files changed, 126 insertions(+), 31 deletions(-) diff --git a/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/BLS12_381.hs b/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/BLS12_381.hs index c9537c133c4..222c7175129 100644 --- a/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/BLS12_381.hs +++ b/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/BLS12_381.hs @@ -29,6 +29,8 @@ import Test.QuickCheck hiding (Some (..)) import Test.Tasty import Test.Tasty.QuickCheck hiding (Some (..)) +import PlutusCore.MkPlc (mkConstant) + -- QuickCheck utilities mkTestName :: forall g. TestableAbelianGroup g => String -> String @@ -39,11 +41,29 @@ withNTests = withMaxSuccess 200 -- QuickCheck generators for scalars and group elements as PLC terms -arbitraryConstant :: forall g. TestableAbelianGroup g => Gen PlcTerm -arbitraryConstant = toTerm <$> (arbitrary @g) +-- An arbitrary nonzero group element. For the BLS12-381 groups it's highly +-- unlikely that we'll get the zero element, but let's make sure. +arbitraryNonZeroConstant :: forall g. TestableAbelianGroup g => Gen PlcTerm +arbitraryNonZeroConstant = (toTerm <$> (arbitrary @g)) `suchThat` ((/=) (zeroTerm @g)) +-- For most tests we want to make sure that we get the zero point reasonably often. +arbitraryConstant :: forall g. TestableAbelianGroup g => Gen PlcTerm +arbitraryConstant = + frequency [ (9, arbitraryNonZeroConstant @g) + , (1, pure (zeroTerm @g)) + ] + +{- Generate an arbitrary scalar. Scalars map on to elements of Z_p where p is the + 381-bit prime involved in BLS12_381. This generator supplies integers up to + 10000 bits long to give us some confidence that the reduction is handled + properly. +-} arbitraryScalar :: Gen PlcTerm -arbitraryScalar = integer <$> (arbitrary @Integer) +arbitraryScalar = + integer <$> + frequency [ (1, arbitrary @Integer) + , (4, choose (-b, b))] + where b = (2::Integer)^(10000::Integer) -- Constructing pairing terms @@ -239,6 +259,74 @@ test_Z_action_good = , test_scalarMul_periodic @g ] +---------------- Multi-scalar multiplication behaves correctly ---------------- + +{- Check that multiScalarMul [s_1, ..., s_m] [p_1, ..., p_n] = + 0 + (s_1*p_1) + ... + (s_r*p_r) where r = min m n +-} +test_multiScalarMul_correct :: forall g. TestableAbelianGroup g => TestTree +test_multiScalarMul_correct = + testProperty + (mkTestName @g "multiScalarMul_is_iterated_mul_and_add") . + withNTests $ do + scalars <- listOf (arbitrary @Integer) + points <- listOf (arbitrary @g) + let e1 = multiScalarMulTerm @g (mkConstant () scalars) (mkConstant () points) + mkMulAdd acc (s, x) = addTerm @g acc (scalarMulTerm @g s x) + scalarTerms = fmap (mkConstant ()) scalars + pointTerms = fmap (mkConstant ()) points + e2 = foldl mkMulAdd (zeroTerm @g) (zip scalarTerms pointTerms) + -- ^ Remember that zip truncates the longer list and `multiScalarMul` + -- is supposed to disregard extra elements if the inputs have different + -- lengths. + pure $ evalTerm e1 === evalTerm e2 + +-- Check that multiScalarMul returns the zero point if the list of scalars is empty +test_multiScalarMul_no_scalars :: forall g. TestableAbelianGroup g => TestTree +test_multiScalarMul_no_scalars = + testProperty + (mkTestName @g "multiScalarMul_returns_zero_if_no_scalars") . + withNTests $ do + points <- listOf (arbitrary @g) + let e = multiScalarMulTerm @g (mkConstant () ([] @Integer)) (mkConstant () points) + pure $ evalTerm e === evalTerm (zeroTerm @g) + +-- Check that multiScalarMul returns the zero point if the list of points is empty +test_multiScalarMul_no_points :: forall g. TestableAbelianGroup g => TestTree +test_multiScalarMul_no_points = + testProperty + (mkTestName @g "multiScalarMul_returns_zero_if_no_points") . + withNTests $ do + scalars <- listOf (arbitrary @Integer) + let e = multiScalarMulTerm @g (mkConstant () scalars) (mkConstant () ([] @g)) + pure $ evalTerm e === evalTerm (zeroTerm @g) + +{- Check that the result of multiScalarMul doesn't change if you permute the input + pairs (disregarding extra inputs when the two input lists are of different + lengths). +-} +test_multiScalarMul_permutation :: forall g. TestableAbelianGroup g => TestTree +test_multiScalarMul_permutation = + testProperty + (mkTestName @g "multiScalarMul_invariant_under_permutation") . + withNTests $ do + l <- listOf (arbitrary @(Integer, g)) + l' <- shuffle l + let (scalars, points) = unzip l + (scalars', points') = unzip l' + e1 = multiScalarMulTerm @g (mkConstant () scalars) (mkConstant () points) + e2 = multiScalarMulTerm @g (mkConstant () scalars') (mkConstant () points') + pure $ evalTerm e1 === evalTerm e2 + + +test_multiScalarMul :: forall g. TestableAbelianGroup g => TestTree +test_multiScalarMul = + testGroup (printf "Multi-scalar multiplication behaves correctly for %s" $ groupName @g) + [ test_multiScalarMul_correct @g + , test_multiScalarMul_no_scalars @g + , test_multiScalarMul_no_points @g + , test_multiScalarMul_permutation @g + ] {- Generic tests for the HashAndCompress class. Later these are instantiated at the G1 and G2 types. -} @@ -437,16 +525,17 @@ test_pairing_balanced = e3 = finalVerifyTerm e1 e2 pure $ evalTerm e3 === cekSuccessTrue --- finalVerify returns False for random inputs +-- Cheack that `finalVerify` returns False for random inputs. We exclude the +-- zero points because `millerLoop` returns 1 if either of its inputs is zero. test_random_pairing :: TestTree test_random_pairing = testProperty "pairing_random_unequal" . withNTests $ do - p1 <- arbitraryConstant @G1.Element - p2 <- arbitraryConstant @G1.Element - q1 <- arbitraryConstant @G2.Element - q2 <- arbitraryConstant @G2.Element + p1 <- arbitraryNonZeroConstant @G1.Element + p2 <- arbitraryNonZeroConstant @G1.Element + q1 <- arbitraryNonZeroConstant @G2.Element + q2 <- arbitraryNonZeroConstant @G2.Element pure $ p1 /= p2 && q1 /= q2 ==> let e = finalVerifyTerm (millerLoopTerm p1 q1) (millerLoopTerm p2 q2) in evalTerm e === cekSuccessFalse @@ -459,11 +548,13 @@ test_BLS12_381 = testGroup "BLS12-381" [ testGroup "G1 properties" [ test_is_an_abelian_group @G1.Element , test_Z_action_good @G1.Element + , test_multiScalarMul @G1.Element , test_compress_hash @G1.Element ] , testGroup "G2 properties" [ test_is_an_abelian_group @G2.Element , test_Z_action_good @G2.Element + , test_multiScalarMul @G2.Element , test_compress_hash @G2.Element ] , testGroup "Pairing properties" diff --git a/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/BLS12_381/TestClasses.hs b/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/BLS12_381/TestClasses.hs index 8bceacafbcd..a540b762e29 100644 --- a/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/BLS12_381/TestClasses.hs +++ b/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/BLS12_381/TestClasses.hs @@ -1,5 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Evaluation.Builtins.BLS12_381.TestClasses @@ -25,15 +26,16 @@ import Test.QuickCheck (Arbitrary (..)) -- We could re-use the AbelianGroup class here, but that uses <> and `mempty` -- and that's confusing. -class (Eq a, Show a, Arbitrary a, ArbitraryBuiltin a) => TestableAbelianGroup a +class (Eq a, Show a, Arbitrary a, ArbitraryBuiltin a, DefaultUni `Contains` a) => TestableAbelianGroup a where - groupName :: String - zeroTerm :: PlcTerm - addTerm :: PlcTerm -> PlcTerm -> PlcTerm - negTerm :: PlcTerm -> PlcTerm - scalarMulTerm :: PlcTerm -> PlcTerm -> PlcTerm - eqTerm :: PlcTerm -> PlcTerm -> PlcTerm - toTerm :: a -> PlcTerm + groupName :: String + zeroTerm :: PlcTerm + addTerm :: PlcTerm -> PlcTerm -> PlcTerm + negTerm :: PlcTerm -> PlcTerm + scalarMulTerm :: PlcTerm -> PlcTerm -> PlcTerm + multiScalarMulTerm :: PlcTerm -> PlcTerm -> PlcTerm + eqTerm :: PlcTerm -> PlcTerm -> PlcTerm + toTerm :: a -> PlcTerm class TestableAbelianGroup a => HashAndCompress a where @@ -48,7 +50,7 @@ class TestableAbelianGroup a => HashAndCompress a element directly without using quite low-level operations on the curve because a random point on the curve is highly unlikely to be in the subgroup G1, but fortunately `hashToGroup` always produces an element of the subgroup, - so we can produce random elements of G1 by hasing random bytestrings. -} + so we can produce random elements of G1 by hashing random bytestrings. -} instance Arbitrary G1.Element where arbitrary = @@ -58,13 +60,14 @@ instance Arbitrary G1.Element instance TestableAbelianGroup G1.Element where - groupName = "G1" - zeroTerm = mkApp1 Bls12_381_G1_uncompress $ bytestring $ pack (0xc0 : replicate 47 0x00) - addTerm = mkApp2 Bls12_381_G1_add - negTerm = mkApp1 Bls12_381_G1_neg - scalarMulTerm = mkApp2 Bls12_381_G1_scalarMul - eqTerm = mkApp2 Bls12_381_G1_equal - toTerm = mkConstant () + groupName = "G1" + zeroTerm = mkApp1 Bls12_381_G1_uncompress $ bytestring $ pack (0xc0 : replicate 47 0x00) + addTerm = mkApp2 Bls12_381_G1_add + negTerm = mkApp1 Bls12_381_G1_neg + scalarMulTerm = mkApp2 Bls12_381_G1_scalarMul + multiScalarMulTerm = mkApp2 Bls12_381_G1_multiScalarMul + eqTerm = mkApp2 Bls12_381_G1_equal + toTerm = mkConstant () instance HashAndCompress G1.Element where @@ -84,13 +87,14 @@ instance Arbitrary G2.Element instance TestableAbelianGroup G2.Element where - groupName = "G2" - zeroTerm = mkApp1 Bls12_381_G2_uncompress $ bytestring $ pack (0xc0 : replicate 95 0x00) - addTerm = mkApp2 Bls12_381_G2_add - negTerm = mkApp1 Bls12_381_G2_neg - scalarMulTerm = mkApp2 Bls12_381_G2_scalarMul - eqTerm = mkApp2 Bls12_381_G2_equal - toTerm = mkConstant () + groupName = "G2" + zeroTerm = mkApp1 Bls12_381_G2_uncompress $ bytestring $ pack (0xc0 : replicate 95 0x00) + addTerm = mkApp2 Bls12_381_G2_add + negTerm = mkApp1 Bls12_381_G2_neg + scalarMulTerm = mkApp2 Bls12_381_G2_scalarMul + multiScalarMulTerm = mkApp2 Bls12_381_G2_multiScalarMul + eqTerm = mkApp2 Bls12_381_G2_equal + toTerm = mkConstant () instance HashAndCompress G2.Element where From fe5e803728b27221c39b777baf0fb5ff2457ea12 Mon Sep 17 00:00:00 2001 From: kwxm Date: Thu, 18 Sep 2025 10:30:45 +0100 Subject: [PATCH 2/4] Update comment --- .../testlib/Evaluation/Builtins/BLS12_381.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/BLS12_381.hs b/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/BLS12_381.hs index 222c7175129..f0fa3105186 100644 --- a/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/BLS12_381.hs +++ b/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/BLS12_381.hs @@ -53,10 +53,10 @@ arbitraryConstant = , (1, pure (zeroTerm @g)) ] -{- Generate an arbitrary scalar. Scalars map on to elements of Z_p where p is the - 381-bit prime involved in BLS12_381. This generator supplies integers up to - 10000 bits long to give us some confidence that the reduction is handled - properly. +{- Generate an arbitrary scalar. Scalars map onto elements of Z_p where p is the + 255-bit prime order of the groups involved in BLS12_381. This generator + supplies integers up to 10000 bits long to give us some confidence that the + reduction is handled properly. -} arbitraryScalar :: Gen PlcTerm arbitraryScalar = From 57fd0ecc706de20558562fb1c4be68402c98fc11 Mon Sep 17 00:00:00 2001 From: kwxm Date: Fri, 19 Sep 2025 10:07:18 +0100 Subject: [PATCH 3/4] Small updates in response to PR comments --- .../testlib/Evaluation/Builtins/BLS12_381.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/BLS12_381.hs b/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/BLS12_381.hs index f0fa3105186..9c45105bf53 100644 --- a/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/BLS12_381.hs +++ b/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/BLS12_381.hs @@ -17,6 +17,7 @@ import Evaluation.Builtins.Common (PlcTerm, TypeErrorOrCekResult (..), bytestrin import PlutusCore.Crypto.BLS12_381.G1 qualified as G1 import PlutusCore.Crypto.BLS12_381.G2 qualified as G2 import PlutusCore.Default +import PlutusCore.Generators.QuickCheck.Builtin (arbitraryBuiltin) import UntypedPlutusCore qualified as UPLC import Cardano.Crypto.EllipticCurve.BLS12_381 (scalarPeriod) @@ -39,6 +40,7 @@ mkTestName s = printf "%s_%s" (groupName @g) s withNTests :: Testable prop => prop -> Property withNTests = withMaxSuccess 200 + -- QuickCheck generators for scalars and group elements as PLC terms -- An arbitrary nonzero group element. For the BLS12-381 groups it's highly @@ -61,7 +63,7 @@ arbitraryConstant = arbitraryScalar :: Gen PlcTerm arbitraryScalar = integer <$> - frequency [ (1, arbitrary @Integer) + frequency [ (1, arbitraryBuiltin @Integer) , (4, choose (-b, b))] where b = (2::Integer)^(10000::Integer) @@ -275,7 +277,7 @@ test_multiScalarMul_correct = mkMulAdd acc (s, x) = addTerm @g acc (scalarMulTerm @g s x) scalarTerms = fmap (mkConstant ()) scalars pointTerms = fmap (mkConstant ()) points - e2 = foldl mkMulAdd (zeroTerm @g) (zip scalarTerms pointTerms) + e2 = List.foldl' mkMulAdd (zeroTerm @g) (zip scalarTerms pointTerms) -- ^ Remember that zip truncates the longer list and `multiScalarMul` -- is supposed to disregard extra elements if the inputs have different -- lengths. From 6d0e4450e8b097dc50af7fd80633aa3184a66bf3 Mon Sep 17 00:00:00 2001 From: kwxm Date: Fri, 19 Sep 2025 11:50:55 +0100 Subject: [PATCH 4/4] Refactoring --- .../testlib/Evaluation/Builtins/BLS12_381.hs | 155 +++++++++--------- .../Builtins/BLS12_381/TestClasses.hs | 49 ++++-- 2 files changed, 111 insertions(+), 93 deletions(-) diff --git a/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/BLS12_381.hs b/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/BLS12_381.hs index 9c45105bf53..bd4e9dd6e30 100644 --- a/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/BLS12_381.hs +++ b/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/BLS12_381.hs @@ -3,6 +3,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -Wno-dodgy-imports #-} @@ -43,41 +44,32 @@ withNTests = withMaxSuccess 200 -- QuickCheck generators for scalars and group elements as PLC terms --- An arbitrary nonzero group element. For the BLS12-381 groups it's highly --- unlikely that we'll get the zero element, but let's make sure. -arbitraryNonZeroConstant :: forall g. TestableAbelianGroup g => Gen PlcTerm -arbitraryNonZeroConstant = (toTerm <$> (arbitrary @g)) `suchThat` ((/=) (zeroTerm @g)) - --- For most tests we want to make sure that we get the zero point reasonably often. -arbitraryConstant :: forall g. TestableAbelianGroup g => Gen PlcTerm -arbitraryConstant = - frequency [ (9, arbitraryNonZeroConstant @g) - , (1, pure (zeroTerm @g)) - ] +-- Convert objects to terms, just for convenience. +asPlc :: DefaultUni `Contains` a => a -> PlcTerm +asPlc = mkConstant () {- Generate an arbitrary scalar. Scalars map onto elements of Z_p where p is the 255-bit prime order of the groups involved in BLS12_381. This generator supplies integers up to 10000 bits long to give us some confidence that the reduction is handled properly. -} -arbitraryScalar :: Gen PlcTerm +arbitraryScalar :: Gen Integer arbitraryScalar = - integer <$> frequency [ (1, arbitraryBuiltin @Integer) , (4, choose (-b, b))] where b = (2::Integer)^(10000::Integer) --- Constructing pairing terms - -millerLoopTerm :: PlcTerm -> PlcTerm -> PlcTerm -millerLoopTerm = mkApp2 Bls12_381_millerLoop - -mulMlResultTerm :: PlcTerm -> PlcTerm -> PlcTerm -mulMlResultTerm = mkApp2 Bls12_381_mulMlResult +-- Arbitrary scalar as PLC constant +arbitraryPlcScalar :: Gen PlcTerm +arbitraryPlcScalar = asPlc <$> arbitraryScalar -finalVerifyTerm :: PlcTerm -> PlcTerm -> PlcTerm -finalVerifyTerm = mkApp2 Bls12_381_finalVerify +-- Arbitrary group element as PLC constant +arbitraryPlcConst :: forall g. (DefaultUni `Contains` g, Arbitrary g) => Gen PlcTerm +arbitraryPlcConst = asPlc <$> arbitrary @g +-- Arbitrary nonzero group element as PLC constant +arbitraryNonZeroPlcConst :: forall g. TestableAbelianGroup g => Gen PlcTerm +arbitraryNonZeroPlcConst = asPlc <$> arbitraryNonZero @g {- Generic tests for the TestableAbelianGroup class. Later these are instantiated at the G1 and G2 types. -} @@ -90,9 +82,9 @@ test_add_assoc = testProperty (mkTestName @g "add_assoc") . withNTests $ do - p1 <- arbitraryConstant @g - p2 <- arbitraryConstant @g - p3 <- arbitraryConstant @g + p1 <- arbitraryPlcConst @g + p2 <- arbitraryPlcConst @g + p3 <- arbitraryPlcConst @g let e = eqTerm @g (addTerm @g p1 (addTerm @g p2 p3)) (addTerm @g (addTerm @g p1 p2) p3) pure $ evalTerm e === cekSuccessTrue @@ -102,7 +94,7 @@ test_add_zero = testProperty (mkTestName @g "add_zero") . withNTests $ do - p <- arbitraryConstant @g + p <- arbitraryPlcConst @g let e = eqTerm @g (addTerm @g p $ zeroTerm @g) p pure $ evalTerm e === cekSuccessTrue @@ -113,7 +105,7 @@ test_neg = testProperty (mkTestName @g "additive_inverse") . withNTests $ do - p <- arbitraryConstant @g + p <- arbitraryPlcConst @g let e = eqTerm @g (addTerm @g p (negTerm @g p)) $ zeroTerm @g pure $ evalTerm e === cekSuccessTrue @@ -123,8 +115,8 @@ test_add_commutative = testProperty (mkTestName @g "add_commutative") . withNTests $ do - p1 <- arbitraryConstant @g - p2 <- arbitraryConstant @g + p1 <- arbitraryPlcConst @g + p2 <- arbitraryPlcConst @g let e = eqTerm @g (addTerm @g p1 p2) (addTerm @g p2 p1) pure $ evalTerm e === cekSuccessTrue @@ -145,9 +137,9 @@ test_scalarMul_assoc = testProperty (mkTestName @g "scalarMul_mul_assoc") . withNTests $ do - m <- arbitraryScalar - n <- arbitraryScalar - p <- arbitraryConstant @g + m <- arbitraryPlcScalar + n <- arbitraryPlcScalar + p <- arbitraryPlcConst @g let e1 = scalarMulTerm @g (mkApp2 MultiplyInteger m n) p e2 = scalarMulTerm @g m (scalarMulTerm @g n p) e3 = eqTerm @g e1 e2 @@ -159,9 +151,9 @@ test_scalarMul_distributive_left = testProperty (mkTestName @g "scalarMul_distributive_left") . withNTests $ do - m <- arbitraryScalar - n <- arbitraryScalar - p <- arbitraryConstant @g + m <- arbitraryPlcScalar + n <- arbitraryPlcScalar + p <- arbitraryPlcConst @g let e1 = scalarMulTerm @g (mkApp2 AddInteger m n) p e2 = addTerm @g (scalarMulTerm @g m p) (scalarMulTerm @g n p) e3 = eqTerm @g e1 e2 @@ -173,9 +165,9 @@ test_scalarMul_distributive_right = testProperty (mkTestName @g "scalarMul_distributive_right") . withNTests $ do - n <- arbitraryScalar - p <- arbitraryConstant @g - q <- arbitraryConstant @g + n <- arbitraryPlcScalar + p <- arbitraryPlcConst @g + q <- arbitraryPlcConst @g let e1 = scalarMulTerm @g n (addTerm @g p q) e2 = addTerm @g (scalarMulTerm @g n p) (scalarMulTerm @g n q) e3 = eqTerm @g e1 e2 @@ -187,7 +179,7 @@ test_scalarMul_zero = testProperty (mkTestName @g "scalarMul_zero") . withNTests $ do - p <- arbitraryConstant @g + p <- arbitraryPlcConst @g let e = eqTerm @g (scalarMulTerm @g (integer 0) p) $ zeroTerm @g pure $ evalTerm e === cekSuccessTrue @@ -197,7 +189,7 @@ test_scalarMul_one = testProperty (mkTestName @g "scalarMul_one") . withNTests $ do - p <- arbitraryConstant @g + p <- arbitraryPlcConst @g let e = eqTerm @g (scalarMulTerm @g (integer 1) p) p pure $ evalTerm e === cekSuccessTrue @@ -207,7 +199,7 @@ test_scalarMul_inverse = testProperty (mkTestName @g "scalarMul_inverse") . withNTests $ do - p <- arbitraryConstant @g + p <- arbitraryPlcConst @g let e = eqTerm @g (scalarMulTerm @g (integer (-1)) p) (negTerm @g p) pure $ evalTerm e == cekSuccessTrue @@ -220,8 +212,8 @@ test_scalarMul_repeated_addition = testProperty (mkTestName @g "scalarMul_repeated_addition") . withNTests $ do - n <- resize 100 arbitrary - p <- arbitraryConstant @g + n <- resize 100 arbitrary -- number of additions + p <- arbitraryPlcConst @g let e1 = repeatedAdd n p e2 = eqTerm @g (scalarMulTerm @g (integer n) p) e1 pure $ evalTerm e2 === cekSuccessTrue @@ -239,9 +231,9 @@ test_scalarMul_periodic = testProperty (mkTestName @g "scalarMul_periodic") . withNTests $ do - m <- arbitraryScalar - n <- arbitraryScalar - p <- arbitraryConstant @g + m <- arbitraryPlcScalar + n <- arbitraryPlcScalar + p <- arbitraryPlcConst @g let e1 = scalarMulTerm @g m p k = mkApp2 AddInteger m (mkApp2 MultiplyInteger n (integer scalarPeriod)) e2 = scalarMulTerm @g k p -- k = m+n|G| @@ -271,12 +263,12 @@ test_multiScalarMul_correct = testProperty (mkTestName @g "multiScalarMul_is_iterated_mul_and_add") . withNTests $ do - scalars <- listOf (arbitrary @Integer) + scalars <- listOf arbitraryScalar points <- listOf (arbitrary @g) - let e1 = multiScalarMulTerm @g (mkConstant () scalars) (mkConstant () points) + let e1 = multiScalarMulTerm @g (asPlc scalars) (asPlc points) mkMulAdd acc (s, x) = addTerm @g acc (scalarMulTerm @g s x) - scalarTerms = fmap (mkConstant ()) scalars - pointTerms = fmap (mkConstant ()) points + scalarTerms = fmap asPlc scalars + pointTerms = fmap asPlc points e2 = List.foldl' mkMulAdd (zeroTerm @g) (zip scalarTerms pointTerms) -- ^ Remember that zip truncates the longer list and `multiScalarMul` -- is supposed to disregard extra elements if the inputs have different @@ -290,7 +282,7 @@ test_multiScalarMul_no_scalars = (mkTestName @g "multiScalarMul_returns_zero_if_no_scalars") . withNTests $ do points <- listOf (arbitrary @g) - let e = multiScalarMulTerm @g (mkConstant () ([] @Integer)) (mkConstant () points) + let e = multiScalarMulTerm @g (asPlc ([] @Integer)) (asPlc points) pure $ evalTerm e === evalTerm (zeroTerm @g) -- Check that multiScalarMul returns the zero point if the list of points is empty @@ -299,8 +291,8 @@ test_multiScalarMul_no_points = testProperty (mkTestName @g "multiScalarMul_returns_zero_if_no_points") . withNTests $ do - scalars <- listOf (arbitrary @Integer) - let e = multiScalarMulTerm @g (mkConstant () scalars) (mkConstant () ([] @g)) + scalars <- listOf arbitraryScalar + let e = multiScalarMulTerm @g (asPlc scalars) (asPlc ([] @g)) pure $ evalTerm e === evalTerm (zeroTerm @g) {- Check that the result of multiScalarMul doesn't change if you permute the input @@ -312,12 +304,12 @@ test_multiScalarMul_permutation = testProperty (mkTestName @g "multiScalarMul_invariant_under_permutation") . withNTests $ do - l <- listOf (arbitrary @(Integer, g)) + l <- listOf ((,) <$> arbitraryScalar <*> arbitrary @g) l' <- shuffle l let (scalars, points) = unzip l (scalars', points') = unzip l' - e1 = multiScalarMulTerm @g (mkConstant () scalars) (mkConstant () points) - e2 = multiScalarMulTerm @g (mkConstant () scalars') (mkConstant () points') + e1 = multiScalarMulTerm @g (asPlc scalars) (asPlc points) + e2 = multiScalarMulTerm @g (asPlc scalars') (asPlc points') pure $ evalTerm e1 === evalTerm e2 @@ -338,7 +330,7 @@ test_roundtrip_compression = testProperty (mkTestName @g "roundtrip_compression") . withNTests $ do - p <- arbitraryConstant @g + p <- arbitraryPlcConst @g let e = eqTerm @g (uncompressTerm @g (compressTerm @g p)) p pure $ evalTerm e === cekSuccessTrue @@ -383,7 +375,7 @@ test_compression_bit_set = testProperty (mkTestName @g "compression_bit_set") . withNTests $ do - p <- arbitraryConstant @g + p <- arbitraryPlcConst @g case evalTerm (compressTerm @g p) of CekSuccess (UPLC.Constant _ (Some (ValueOf DefaultUniByteString bs))) -> pure $ isSet compressionBit bs @@ -400,14 +392,14 @@ test_clear_compression_bit = e = uncompressTerm @g (bytestring b) pure $ evalTerm e === CekError --- | Check that flipping the sign bit in a compressed point gives the inverse of --- the point. +-- | Check that flipping the sign bit in a compressed nonzero point gives the +-- inverse of the point. test_flip_sign_bit :: forall g. HashAndCompress g => TestTree test_flip_sign_bit = testProperty (mkTestName @g "flip_sign_bit") . withNTests $ do - p <- arbitrary @g + p <- arbitraryNonZero @g let b1 = compress @g p b2 = flipBits signBit b1 e1 = uncompressTerm @g (bytestring b1) @@ -421,7 +413,7 @@ test_set_infinity_bit = testProperty (mkTestName @g "set_infinity_bit") . withNTests $ do - p <- arbitrary @g + p <- arbitraryNonZero @g -- This will have the infinity bit set. let b = setBits infinityBit $ compress @g p e = uncompressTerm @g (bytestring b) pure $ evalTerm e === CekError @@ -485,15 +477,26 @@ test_compress_hash = ---------------- Pairing properties ---------------- +-- Constructing pairing terms + +millerLoopTerm :: PlcTerm -> PlcTerm -> PlcTerm +millerLoopTerm = mkApp2 Bls12_381_millerLoop + +mulMlResultTerm :: PlcTerm -> PlcTerm -> PlcTerm +mulMlResultTerm = mkApp2 Bls12_381_mulMlResult + +finalVerifyTerm :: PlcTerm -> PlcTerm -> PlcTerm +finalVerifyTerm = mkApp2 Bls12_381_finalVerify + -- = . test_pairing_left_additive :: TestTree test_pairing_left_additive = testProperty "pairing_left_additive" . withNTests $ do - p1 <- arbitraryConstant @G1.Element - p2 <- arbitraryConstant @G1.Element - q <- arbitraryConstant @G2.Element + p1 <- arbitraryPlcConst @G1.Element + p2 <- arbitraryPlcConst @G1.Element + q <- arbitraryPlcConst @G2.Element let e1 = millerLoopTerm (addTerm @G1.Element p1 p2) q e2 = mulMlResultTerm (millerLoopTerm p1 q) (millerLoopTerm p2 q) e3 = finalVerifyTerm e1 e2 @@ -505,9 +508,9 @@ test_pairing_right_additive = testProperty "pairing_right_additive" . withNTests $ do - p <- arbitraryConstant @G1.Element - q1 <- arbitraryConstant @G2.Element - q2 <- arbitraryConstant @G2.Element + p <- arbitraryPlcConst @G1.Element + q1 <- arbitraryPlcConst @G2.Element + q2 <- arbitraryPlcConst @G2.Element let e1 = millerLoopTerm p (addTerm @G2.Element q1 q2) e2 = mulMlResultTerm (millerLoopTerm p q1) (millerLoopTerm p q2) e3 = finalVerifyTerm e1 e2 @@ -519,25 +522,25 @@ test_pairing_balanced = testProperty "pairing_balanced" . withNTests $ do - n <- arbitraryScalar - p <- arbitraryConstant @G1.Element - q <- arbitraryConstant @G2.Element + n <- arbitraryPlcScalar + p <- arbitraryPlcConst @G1.Element + q <- arbitraryPlcConst @G2.Element let e1 = millerLoopTerm (scalarMulTerm @G1.Element n p) q e2 = millerLoopTerm p (scalarMulTerm @G2.Element n q) e3 = finalVerifyTerm e1 e2 pure $ evalTerm e3 === cekSuccessTrue --- Cheack that `finalVerify` returns False for random inputs. We exclude the +-- Check that `finalVerify` returns False for random inputs. We exclude the -- zero points because `millerLoop` returns 1 if either of its inputs is zero. test_random_pairing :: TestTree test_random_pairing = testProperty "pairing_random_unequal" . withNTests $ do - p1 <- arbitraryNonZeroConstant @G1.Element - p2 <- arbitraryNonZeroConstant @G1.Element - q1 <- arbitraryNonZeroConstant @G2.Element - q2 <- arbitraryNonZeroConstant @G2.Element + p1 <- arbitraryNonZeroPlcConst @G1.Element + p2 <- arbitraryNonZeroPlcConst @G1.Element + q1 <- arbitraryNonZeroPlcConst @G2.Element + q2 <- arbitraryNonZeroPlcConst @G2.Element pure $ p1 /= p2 && q1 /= q2 ==> let e = finalVerifyTerm (millerLoopTerm p1 q1) (millerLoopTerm p2 q2) in evalTerm e === cekSuccessFalse diff --git a/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/BLS12_381/TestClasses.hs b/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/BLS12_381/TestClasses.hs index a540b762e29..bad1be351ea 100644 --- a/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/BLS12_381/TestClasses.hs +++ b/plutus-core/untyped-plutus-core/testlib/Evaluation/Builtins/BLS12_381/TestClasses.hs @@ -1,12 +1,13 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Evaluation.Builtins.BLS12_381.TestClasses where -import Evaluation.Builtins.Common (PlcTerm, bytestring, mkApp1, mkApp2) +import Evaluation.Builtins.Common (PlcTerm, mkApp1, mkApp2) import PlutusCore.Crypto.BLS12_381.G1 qualified as G1 import PlutusCore.Crypto.BLS12_381.G2 qualified as G2 @@ -14,8 +15,8 @@ import PlutusCore.Default import PlutusCore.Generators.QuickCheck.Builtin (ArbitraryBuiltin) import PlutusCore.MkPlc (mkConstant) -import Data.ByteString as BS (ByteString, empty, pack) -import Test.QuickCheck (Arbitrary (..)) +import Data.ByteString as BS (ByteString, empty) +import Test.QuickCheck (Arbitrary (..), Gen, frequency, suchThat) ---------------- Typeclasses for groups ---------------- @@ -29,13 +30,20 @@ import Test.QuickCheck (Arbitrary (..)) class (Eq a, Show a, Arbitrary a, ArbitraryBuiltin a, DefaultUni `Contains` a) => TestableAbelianGroup a where groupName :: String - zeroTerm :: PlcTerm + zero :: a addTerm :: PlcTerm -> PlcTerm -> PlcTerm negTerm :: PlcTerm -> PlcTerm scalarMulTerm :: PlcTerm -> PlcTerm -> PlcTerm multiScalarMulTerm :: PlcTerm -> PlcTerm -> PlcTerm eqTerm :: PlcTerm -> PlcTerm -> PlcTerm - toTerm :: a -> PlcTerm + +zeroTerm :: forall g. TestableAbelianGroup g => PlcTerm +zeroTerm = mkConstant () $ zero @g + +-- An arbitrary nonzero group element. For the BLS12-381 groups it's highly +-- unlikely that we'll get the zero element, but let's make sure. +arbitraryNonZero :: forall g. TestableAbelianGroup g => Gen g +arbitraryNonZero = (arbitrary @g) `suchThat` ((/=) (zero @g)) class TestableAbelianGroup a => HashAndCompress a where @@ -45,6 +53,7 @@ class TestableAbelianGroup a => HashAndCompress a uncompressTerm :: PlcTerm -> PlcTerm hashToGroupTerm :: PlcTerm -> PlcTerm -> PlcTerm +---------- Instances for G1 ---------- {- | Generate an arbitrary element of G1. It's tricky to construct such an element directly without using quite low-level operations on the curve @@ -53,21 +62,23 @@ class TestableAbelianGroup a => HashAndCompress a so we can produce random elements of G1 by hashing random bytestrings. -} instance Arbitrary G1.Element where - arbitrary = - G1.hashToGroup <$> arbitrary <*> pure BS.empty >>= \case - Left err -> error $ "Arbitrary instance for G1.Element:" ++ show err - Right p -> pure p + arbitrary = frequency [ (9, arbitraryElement) + , (1, pure $ G1.offchain_zero) + ] + where arbitraryElement = + G1.hashToGroup <$> arbitrary <*> pure BS.empty >>= \case + Left err -> error $ "Arbitrary instance for G1.Element:" ++ show err + Right p -> pure p instance TestableAbelianGroup G1.Element where groupName = "G1" - zeroTerm = mkApp1 Bls12_381_G1_uncompress $ bytestring $ pack (0xc0 : replicate 47 0x00) + zero = G1.offchain_zero addTerm = mkApp2 Bls12_381_G1_add negTerm = mkApp1 Bls12_381_G1_neg scalarMulTerm = mkApp2 Bls12_381_G1_scalarMul multiScalarMulTerm = mkApp2 Bls12_381_G1_multiScalarMul eqTerm = mkApp2 Bls12_381_G1_equal - toTerm = mkConstant () instance HashAndCompress G1.Element where @@ -77,24 +88,28 @@ instance HashAndCompress G1.Element uncompressTerm = mkApp1 Bls12_381_G1_uncompress hashToGroupTerm = mkApp2 Bls12_381_G1_hashToGroup +---------- Instances for G2 ---------- + -- | See the comment for the Arbitrary instance for G1. instance Arbitrary G2.Element where - arbitrary = - G2.hashToGroup <$> arbitrary <*> pure BS.empty >>= \case - Left err -> error $ "Arbitrary instance for G2.Element:" ++ show err - Right p -> pure p + arbitrary = frequency [ (9, arbitraryElement) + , (1, pure $ G2.offchain_zero) + ] + where arbitraryElement = + G2.hashToGroup <$> arbitrary <*> pure BS.empty >>= \case + Left err -> error $ "Arbitrary instance for G2.Element:" ++ show err + Right p -> pure p instance TestableAbelianGroup G2.Element where groupName = "G2" - zeroTerm = mkApp1 Bls12_381_G2_uncompress $ bytestring $ pack (0xc0 : replicate 95 0x00) + zero = G2.offchain_zero addTerm = mkApp2 Bls12_381_G2_add negTerm = mkApp1 Bls12_381_G2_neg scalarMulTerm = mkApp2 Bls12_381_G2_scalarMul multiScalarMulTerm = mkApp2 Bls12_381_G2_multiScalarMul eqTerm = mkApp2 Bls12_381_G2_equal - toTerm = mkConstant () instance HashAndCompress G2.Element where