cleveland-0.1.0: morley-test/Test/Tezos/Crypto/BLS12381.hs
-- SPDX-FileCopyrightText: 2021 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ
-- | Tests for 'Morley.Tezos.Crypto.BLS12381'.
--
-- Tezos has some Python tests that we make use of in our module:
-- <https://gitlab.com/metastatedev/tezos/-/commit/f10c39e0030e6b4fdd416a62de7b80b6ffdfeacf>.
module Test.Tezos.Crypto.BLS12381
( test_SerializationRoundtrip
, test_SerializationTrivialCases
, test_SerializationEdgeCases
, test_PairingCheck
) where
import Prelude hiding (negate)
import qualified Data.ByteString as BS
import Hedgehog (Gen, assert, forAll, property, withTests, (===))
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Test.HUnit ((@?=))
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase)
import Test.Tasty.Hedgehog (testProperty)
import Hedgehog.Gen.Tezos.Crypto.BLS12381
import Morley.Tezos.Crypto.BLS12381
import Morley.Util.Named ((!))
import Test.Cleveland.Util hiding (fromHex)
test_SerializationRoundtrip :: [TestTree]
test_SerializationRoundtrip =
[ roundtripTest genBls12381Fr
, roundtripTest genBls12381G1
, roundtripTest genBls12381G2
]
where
roundtripTest gen =
roundtripTree gen toMichelsonBytes fromMichelsonBytes
test_SerializationTrivialCases :: [TestTree]
test_SerializationTrivialCases =
[ testGroup "Zero"
[ testCase "Fr" $
zero @Bls12381Fr @?=
-- this and other constants are defined below
unsafeFromMichelsonBytes frZeroValue
, testCase "G1" $
zero @Bls12381G1 @?=
unsafeFromMichelsonBytes g1ZeroValue
, testCase "G2" $
zero @Bls12381G2 @?=
unsafeFromMichelsonBytes g2ZeroValue
]
, testGroup "One"
[ testCase "Fr" $
(1 :: Bls12381Fr) @?=
unsafeFromMichelsonBytes frOneValue
, testCase "G1" $
g1One @?=
unsafeFromMichelsonBytes g1OneValue
, testCase "G2" $
g2One @?=
unsafeFromMichelsonBytes g2OneValue
]
, testGroup "Negate one"
[ testCase "Fr" $
negate (1 :: Bls12381Fr) @?=
unsafeFromMichelsonBytes frMinusOneValue
, testCase "G1" $
negate g1One @?=
unsafeFromMichelsonBytes g1MinusOneValue
, testCase "G2" $
negate g2One @?=
unsafeFromMichelsonBytes g2MinusOneValue
]
]
test_SerializationEdgeCases :: [TestTree]
test_SerializationEdgeCases =
[ testGroup "Fr"
[ testCase "Smaller length" $
fromMichelsonBytes @Bls12381Fr (unsafeFromHex "0100")
@?= Right 1
, testCase "Larger length" $
fromMichelsonBytes @Bls12381Fr (unsafeFromHex $ mconcat $ replicate 33 "00")
@?= Left (TooLargeLength ! #limit 32 ! #given 33)
, testCase "Too big bytes value" $
fromMichelsonBytes @Bls12381Fr frMaxBoundPlusOne
@?= Left (ValueOutsideOfField $ toInteger @Bls12381Fr maxBound + 1)
, testCase "Big decimal value" $
-- We assume that 'fromIntegralOverflowing' is used to read numeric bls12_381_fr
-- values in Michelson
fromIntegralOverflowing @Integer @Bls12381Fr (toInteger @Bls12381Fr maxBound + 1)
@?= 0
, testCase "Negative decimal value" $
fromIntegralOverflowing @Integer @Bls12381Fr (-1)
@?= (-1)
]
, testGroup "G1"
[ testCase "Smaller length" $
fromMichelsonBytes @Bls12381G1 (stripLastByte g1SomeVal)
@?= Left (UnexpectedLength ! #expected 96 ! #given 95)
, testCase "Larger length" $
fromMichelsonBytes @Bls12381G1 (g1SomeVal <> "\0")
@?= Left (UnexpectedLength ! #expected 96 ! #given 97)
, testCase "Bad value" $
fromMichelsonBytes @Bls12381G1 (incrementBytes g1SomeVal)
@?= Left (PointNotOnCurve $ incrementBytes g1SomeVal)
]
, testGroup "G2"
[ testCase "Smaller length" $
fromMichelsonBytes @Bls12381G2 (stripLastByte g2SomeVal)
@?= Left (UnexpectedLength ! #expected 192 ! #given 191)
, testCase "Larger length" $
fromMichelsonBytes @Bls12381G2 (g2SomeVal <> "\0")
@?= Left (UnexpectedLength ! #expected 192 ! #given 193)
, testCase "Bad value" $
fromMichelsonBytes @Bls12381G2 (incrementBytes g2SomeVal)
@?= Left (PointNotOnCurve $ incrementBytes g2SomeVal)
]
]
test_PairingCheck :: [TestTree]
test_PairingCheck =
[ testCase "Empty list" $
-- Definition of @PAIRING_CHECK@ instruction explicitly says the expected
-- behaviour for an empty list
checkPairing [] @?= True
, testProperty "Random stuff" $ withTests 5 $ property do
-- If randomly generated points ever paired (after a reasonably limited
-- number of attempts), then this curve would have problems
pairs <- forAll $ Gen.list (Range.linear 1 10) genPair
checkPairing pairs === False
, testGroup "Non-trivial pairing matches"
[ testProperty "Pairing with negative" $ withTests 1 $ property do
-- This property is from here: https://github.com/ethereum/py_ecc/blob/3f644b4c07c8270b8fbe989eb799766aca66face/tests/test_bn128_and_bls12_381.py#L277
(g1, g2) <- forAll genPair
assert $ checkPairing [(g1, g2), (g1, negate g2)]
assert $ checkPairing [(g1, g2), (negate g1, g2)]
]
]
where
genPair :: Gen (Bls12381G1, Bls12381G2)
genPair = (,) <$> genBls12381G1 <*> genBls12381G2
-- Helpers
----------------------------------------------------------------------------
stripLastByte :: ByteString -> ByteString
stripLastByte bs = BS.take (BS.length bs - 1) bs
incrementBytes :: HasCallStack => ByteString -> ByteString
incrementBytes bs' = case BS.unsnoc bs' of
Nothing -> error ":/"
Just (bs, b) -> BS.snoc bs (b + 1)
frMaxBoundPlusOne :: ByteString
frMaxBoundPlusOne = unsafeFromHex "01000000fffffffffe5bfeff02a4bd5305d8a10908d83933487d9d2953a7ed73"
-- Constants (taken from Tezos tests mentioned at the top)
----------------------------------------------------------------------------
g1SomeVal :: ByteString
g1SomeVal = unsafeFromHex "026fcea34d1a4c5125142dfa3b616086309cab49e60e548d95de658af4d9329c269dc132bd5d884617e8767600daeee90c6f5d25f3d63540f3b799d291e5df4a90244346ed780d5c9d3afa8f3c9a196e089fa4edc4a9806592e8561d626579e3"
g2SomeVal :: ByteString
g2SomeVal = unsafeFromHex "14e9b22683a66543ec447b7aa76e4404424709728507581d0b3f60a8062c3f7c7d3365197c59f7c961fa9731084f5be60d0a936e93d556bdef2032cdcae2fa9902dcbe105e01d7ab7126d83486d882c4efd2fc1ac55044157333be19acf0cb7a10bc41c8081c9babd8d5b41b645badd4a679b3d4e1b3ea2c0e1f53b39c00b3889a40306c9b9ee2da5831e90148334d91016474d07e0f4e36d2d51b5ca11b633b9a940b9c126aebf4a2537c18fdc6967fb677824bfa902157e53cb499a021e57b"
frZeroValue :: ByteString
frZeroValue = unsafeFromHex "0000000000000000000000000000000000000000000000000000000000000000"
g1ZeroValue :: ByteString
g1ZeroValue = unsafeFromHex "400000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
g2ZeroValue :: ByteString
g2ZeroValue = unsafeFromHex "400000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
frOneValue :: ByteString
frOneValue = unsafeFromHex "0100000000000000000000000000000000000000000000000000000000000000"
g1OneValue :: ByteString
g1OneValue = unsafeFromHex "17f1d3a73197d7942695638c4fa9ac0fc3688c4f9774b905a14e3a3f171bac586c55e83ff97a1aeffb3af00adb22c6bb08b3f481e3aaa0f1a09e30ed741d8ae4fcf5e095d5d00af600db18cb2c04b3edd03cc744a2888ae40caa232946c5e7e1"
g2OneValue :: ByteString
g2OneValue = unsafeFromHex "13e02b6052719f607dacd3a088274f65596bd0d09920b61ab5da61bbdc7f5049334cf11213945d57e5ac7d055d042b7e024aa2b2f08f0a91260805272dc51051c6e47ad4fa403b02b4510b647ae3d1770bac0326a805bbefd48056c8c121bdb80606c4a02ea734cc32acd2b02bc28b99cb3e287e85a763af267492ab572e99ab3f370d275cec1da1aaa9075ff05f79be0ce5d527727d6e118cc9cdc6da2e351aadfd9baa8cbdd3a76d429a695160d12c923ac9cc3baca289e193548608b82801"
frMinusOneValue :: ByteString
frMinusOneValue = unsafeFromHex "00000000fffffffffe5bfeff02a4bd5305d8a10908d83933487d9d2953a7ed73"
g1MinusOneValue :: ByteString
g1MinusOneValue = unsafeFromHex "17f1d3a73197d7942695638c4fa9ac0fc3688c4f9774b905a14e3a3f171bac586c55e83ff97a1aeffb3af00adb22c6bb114d1d6855d545a8aa7d76c8cf2e21f267816aef1db507c96655b9d5caac42364e6f38ba0ecb751bad54dcd6b939c2ca"
g2MinusOneValue :: ByteString
g2MinusOneValue = unsafeFromHex "13e02b6052719f607dacd3a088274f65596bd0d09920b61ab5da61bbdc7f5049334cf11213945d57e5ac7d055d042b7e024aa2b2f08f0a91260805272dc51051c6e47ad4fa403b02b4510b647ae3d1770bac0326a805bbefd48056c8c121bdb813fa4d4a0ad8b1ce186ed5061789213d993923066dddaf1040bc3ff59f825c78df74f2d75467e25e0f55f8a00fa030ed0d1b3cc2c7027888be51d9ef691d77bcb679afda66c73f17f9ee3837a55024f78c71363275a75d75d86bab79f74782aa"