-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | 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 Data.ByteString qualified as BS
import Hedgehog (Gen, assert, forAll, property, withTests, (===))
import Hedgehog.Gen qualified as Gen
import Hedgehog.Range qualified 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

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
        unsafe (fromMichelsonBytes frZeroValue)

    , testCase "G1" $
        zero @Bls12381G1 @?=
        unsafe (fromMichelsonBytes g1ZeroValue)

    , testCase "G2" $
        zero @Bls12381G2 @?=
        unsafe (fromMichelsonBytes g2ZeroValue)

    ]

  , testGroup "One"
    [ testCase "Fr" $
        (1 :: Bls12381Fr) @?=
        unsafe (fromMichelsonBytes frOneValue)

    , testCase "G1" $
        g1One @?=
        unsafe (fromMichelsonBytes g1OneValue)

    , testCase "G2" $
        g2One @?=
        unsafe (fromMichelsonBytes g2OneValue)

    ]

  , testGroup "Negate one"
    [ testCase "Fr" $
        negate (1 :: Bls12381Fr) @?=
        unsafe (fromMichelsonBytes frMinusOneValue)

    , testCase "G1" $
        negate g1One @?=
        unsafe (fromMichelsonBytes g1MinusOneValue)

    , testCase "G2" $
        negate g2One @?=
        unsafe (fromMichelsonBytes g2MinusOneValue)

    ]

  ]

test_SerializationEdgeCases :: [TestTree]
test_SerializationEdgeCases =
  [ testGroup "Fr"
    [ testCase "Smaller length" $
        fromMichelsonBytes @Bls12381Fr (unsafe $ fromHex "0100")
        @?= Right 1

    , testCase "Larger length" $
        fromMichelsonBytes @Bls12381Fr (unsafe . fromHex . 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 = unsafe $ fromHex "01000000fffffffffe5bfeff02a4bd5305d8a10908d83933487d9d2953a7ed73"

-- Constants (taken from Tezos tests mentioned at the top)
----------------------------------------------------------------------------

g1SomeVal :: ByteString
g1SomeVal = unsafe $ fromHex "026fcea34d1a4c5125142dfa3b616086309cab49e60e548d95de658af4d9329c269dc132bd5d884617e8767600daeee90c6f5d25f3d63540f3b799d291e5df4a90244346ed780d5c9d3afa8f3c9a196e089fa4edc4a9806592e8561d626579e3"

g2SomeVal :: ByteString
g2SomeVal = unsafe $ fromHex "14e9b22683a66543ec447b7aa76e4404424709728507581d0b3f60a8062c3f7c7d3365197c59f7c961fa9731084f5be60d0a936e93d556bdef2032cdcae2fa9902dcbe105e01d7ab7126d83486d882c4efd2fc1ac55044157333be19acf0cb7a10bc41c8081c9babd8d5b41b645badd4a679b3d4e1b3ea2c0e1f53b39c00b3889a40306c9b9ee2da5831e90148334d91016474d07e0f4e36d2d51b5ca11b633b9a940b9c126aebf4a2537c18fdc6967fb677824bfa902157e53cb499a021e57b"

frZeroValue :: ByteString
frZeroValue = unsafe $ fromHex "0000000000000000000000000000000000000000000000000000000000000000"

g1ZeroValue :: ByteString
g1ZeroValue = unsafe $ fromHex "400000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"

g2ZeroValue :: ByteString
g2ZeroValue = unsafe $ fromHex "400000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"

frOneValue :: ByteString
frOneValue = unsafe $ fromHex "0100000000000000000000000000000000000000000000000000000000000000"

g1OneValue :: ByteString
g1OneValue = unsafe $ fromHex "17f1d3a73197d7942695638c4fa9ac0fc3688c4f9774b905a14e3a3f171bac586c55e83ff97a1aeffb3af00adb22c6bb08b3f481e3aaa0f1a09e30ed741d8ae4fcf5e095d5d00af600db18cb2c04b3edd03cc744a2888ae40caa232946c5e7e1"

g2OneValue :: ByteString
g2OneValue = unsafe $ fromHex "13e02b6052719f607dacd3a088274f65596bd0d09920b61ab5da61bbdc7f5049334cf11213945d57e5ac7d055d042b7e024aa2b2f08f0a91260805272dc51051c6e47ad4fa403b02b4510b647ae3d1770bac0326a805bbefd48056c8c121bdb80606c4a02ea734cc32acd2b02bc28b99cb3e287e85a763af267492ab572e99ab3f370d275cec1da1aaa9075ff05f79be0ce5d527727d6e118cc9cdc6da2e351aadfd9baa8cbdd3a76d429a695160d12c923ac9cc3baca289e193548608b82801"

frMinusOneValue :: ByteString
frMinusOneValue = unsafe $ fromHex "00000000fffffffffe5bfeff02a4bd5305d8a10908d83933487d9d2953a7ed73"

g1MinusOneValue :: ByteString
g1MinusOneValue = unsafe $ fromHex "17f1d3a73197d7942695638c4fa9ac0fc3688c4f9774b905a14e3a3f171bac586c55e83ff97a1aeffb3af00adb22c6bb114d1d6855d545a8aa7d76c8cf2e21f267816aef1db507c96655b9d5caac42364e6f38ba0ecb751bad54dcd6b939c2ca"

g2MinusOneValue :: ByteString
g2MinusOneValue = unsafe $ fromHex "13e02b6052719f607dacd3a088274f65596bd0d09920b61ab5da61bbdc7f5049334cf11213945d57e5ac7d055d042b7e024aa2b2f08f0a91260805272dc51051c6e47ad4fa403b02b4510b647ae3d1770bac0326a805bbefd48056c8c121bdb813fa4d4a0ad8b1ce186ed5061789213d993923066dddaf1040bc3ff59f825c78df74f2d75467e25e0f55f8a00fa030ed0d1b3cc2c7027888be51d9ef691d77bcb679afda66c73f17f9ee3837a55024f78c71363275a75d75d86bab79f74782aa"