{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Crypto.EllipticCurve
where

import Paths_cardano_crypto_tests

import Test.Crypto.Util (eitherShowError)

import qualified Cardano.Crypto.EllipticCurve.BLS12_381 as BLS
import qualified Cardano.Crypto.EllipticCurve.BLS12_381.Internal as BLS
import Cardano.Crypto.Hash (SHA256, digest)
import Data.Bits (shiftL)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Char8 as BS8
import qualified Data.Foldable as F (foldl')
import Data.Proxy (Proxy (..))
import System.IO.Unsafe (unsafePerformIO)
import Test.Crypto.Instances ()
import Test.QuickCheck (
  Arbitrary (..),
  Property,
  choose,
  chooseAny,
  oneof,
  suchThatMap,
  (===),
  (==>),
 )
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (assertBool, assertEqual, testCase)
import Test.Tasty.QuickCheck (testProperty)

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Crypto.EllipticCurve"
    [ TestName -> [TestTree] -> TestTree
testGroup
        TestName
"BLS12_381"
        [ TestName -> TestTree
testUtil TestName
"Utility"
        , TestName -> TestTree
testScalar TestName
"Scalar"
        , forall curve. BLS curve => TestName -> Proxy curve -> TestTree
testBLSCurve TestName
"Curve 1" (forall {k} (t :: k). Proxy t
Proxy @BLS.Curve1)
        , forall curve. BLS curve => TestName -> Proxy curve -> TestTree
testBLSCurve TestName
"Curve 2" (forall {k} (t :: k). Proxy t
Proxy @BLS.Curve2)
        , TestName -> TestTree
testPT TestName
"PT"
        , TestName -> TestTree
testPairing TestName
"Pairing"
        , TestName -> TestTree
testVectors TestName
"Vectors"
        ]
    ]

testUtil :: String -> TestTree
testUtil :: TestName -> TestTree
testUtil TestName
name =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
name
    [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Integer / C-String 32 round-trip" forall a b. (a -> b) -> a -> b
$
        \Integer
n ->
          Integer
n forall a. Ord a => a -> a -> Bool
>= Integer
0 forall prop. Testable prop => Bool -> prop -> Property
==>
            Integer
n forall a. Ord a => a -> a -> Bool
< (Integer
1 forall a. Bits a => a -> Int -> a
`shiftL` Int
32 forall a. Num a => a -> a -> a
* Integer
8) forall prop. Testable prop => Bool -> prop -> Property
==>
              Integer
n forall a. (Eq a, Show a) => a -> a -> Property
=== forall a. IO a -> a
unsafePerformIO (forall a. Int -> Integer -> (Ptr CChar -> Int -> IO a) -> IO a
BLS.integerAsCStrL Int
32 Integer
n Ptr CChar -> Int -> IO Integer
BLS.cstrToInteger)
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"padBS min length" forall a b. (a -> b) -> a -> b
$ \Int
n [Word8]
bsw ->
        ByteString -> Int
BS.length (Int -> ByteString -> ByteString
BLS.padBS Int
n ([Word8] -> ByteString
BS.pack [Word8]
bsw)) forall a. Ord a => a -> a -> Bool
>= Int
n
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"padBS adds zeroes to front" forall a b. (a -> b) -> a -> b
$ \[Word8]
bsw ->
        HasCallStack => ByteString -> Int -> Word8
BS.index (Int -> ByteString -> ByteString
BLS.padBS (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
bsw forall a. Num a => a -> a -> a
+ Int
1) ([Word8] -> ByteString
BS.pack [Word8]
bsw)) Int
0 forall a. (Eq a, Show a) => a -> a -> Property
=== Word8
0
    , TestName -> Assertion -> TestTree
testCase TestName
"integerToBS" forall a b. (a -> b) -> a -> b
$ do
        forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual TestName
"0x1234" ([Word8] -> ByteString
BS.pack [Word8
0x12, Word8
0x34]) (Integer -> ByteString
BLS.integerToBS Integer
0x1234)
        forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual TestName
"0x12345678" ([Word8] -> ByteString
BS.pack [Word8
0x12, Word8
0x34, Word8
0x56, Word8
0x78]) (Integer -> ByteString
BLS.integerToBS Integer
0x12345678)
    ]

testScalar :: String -> TestTree
testScalar :: TestName -> TestTree
testScalar TestName
name =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
name
    [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"self-equality" forall a b. (a -> b) -> a -> b
$
        \(Scalar
a :: BLS.Scalar) -> Scalar
a forall a. (Eq a, Show a) => a -> a -> Property
=== Scalar
a
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"to/from BS round-trip" forall a b. (a -> b) -> a -> b
$
        \Scalar
s -> forall a b. b -> Either a b
Right Scalar
s forall a. (Eq a, Show a) => a -> a -> Property
=== (ByteString -> Either BLSTError Scalar
BLS.scalarFromBS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scalar -> ByteString
BLS.scalarToBS forall a b. (a -> b) -> a -> b
$ Scalar
s)
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"non-negative" forall a b. (a -> b) -> a -> b
$
        \Scalar
s -> (forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scalar -> IO Integer
BLS.scalarToInteger forall a b. (a -> b) -> a -> b
$ Scalar
s) forall a. Ord a => a -> a -> Bool
>= Integer
0
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"to/from Integer round-trip" forall a b. (a -> b) -> a -> b
$
        \Scalar
s -> Scalar
s forall a. (Eq a, Show a) => a -> a -> Property
=== forall a. IO a -> a
unsafePerformIO (Scalar -> IO Integer
BLS.scalarToInteger Scalar
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Integer -> IO Scalar
BLS.scalarFromInteger)
    , TestName -> Assertion -> TestTree
testCase TestName
"integer from scalar" forall a b. (a -> b) -> a -> b
$ do
        Scalar
s <- case ByteString -> Either BLSTError Scalar
BLS.scalarFromBS (Int -> ByteString -> ByteString
BLS.padBS Int
32 ([Word8] -> ByteString
BS.pack [Word8
0x12, Word8
0x34])) of
          Left BLSTError
err -> forall a. HasCallStack => TestName -> a
error (forall a. Show a => a -> TestName
show BLSTError
err)
          Right Scalar
x -> forall (m :: * -> *) a. Monad m => a -> m a
return Scalar
x
        let expected :: Integer
expected = Integer
0x1234
        Integer
actual <- Scalar -> IO Integer
BLS.scalarToInteger Scalar
s
        forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual TestName
"0x1234" Integer
expected Integer
actual
    ]

testBLSCurve ::
  forall curve.
  BLS.BLS curve =>
  String -> Proxy curve -> TestTree
testBLSCurve :: forall curve. BLS curve => TestName -> Proxy curve -> TestTree
testBLSCurve TestName
name Proxy curve
_ =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
name
    [ TestName -> Assertion -> TestTree
testCase TestName
"generator in group" forall a b. (a -> b) -> a -> b
$
        HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
"" (forall curve. BLS curve => Point curve -> Bool
BLS.blsInGroup (forall curve. BLS curve => Point curve
BLS.blsGenerator @curve))
    , TestName -> Assertion -> TestTree
testCase TestName
"neg generator in group" forall a b. (a -> b) -> a -> b
$
        HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
"" (forall curve. BLS curve => Point curve -> Bool
BLS.blsInGroup (forall curve. BLS curve => Point curve -> Point curve
BLS.blsNeg (forall curve. BLS curve => Point curve
BLS.blsGenerator @curve)))
    , TestName -> Assertion -> TestTree
testCase TestName
"add generator to itself" forall a b. (a -> b) -> a -> b
$
        HasCallStack => TestName -> Bool -> Assertion
assertBool
          TestName
""
          (forall curve. BLS curve => Point curve -> Bool
BLS.blsInGroup (forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
BLS.blsAddOrDouble (forall curve. BLS curve => Point curve
BLS.blsGenerator @curve) (forall curve. BLS curve => Point curve
BLS.blsGenerator @curve)))
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"in group" (forall curve. BLS curve => Point curve -> Bool
BLS.blsInGroup @curve)
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"neg in group" (forall curve. BLS curve => Point curve -> Bool
BLS.blsInGroup @curve forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall curve. BLS curve => Point curve -> Point curve
BLS.blsNeg)
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"self-equality" (\(Point curve
a :: BLS.Point curve) -> Point curve
a forall a. (Eq a, Show a) => a -> a -> Property
=== Point curve
a)
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"double negation" (\(Point curve
a :: BLS.Point curve) -> Point curve
a forall a. (Eq a, Show a) => a -> a -> Property
=== forall curve. BLS curve => Point curve -> Point curve
BLS.blsNeg (forall curve. BLS curve => Point curve -> Point curve
BLS.blsNeg Point curve
a))
    , forall a. Testable a => TestName -> a -> TestTree
testProperty
        TestName
"adding infinity yields equality"
        (\(Point curve
a :: BLS.Point curve) -> forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
BLS.blsAddOrDouble Point curve
a (forall curve. BLS curve => Point curve
BLS.blsZero @curve) forall a. (Eq a, Show a) => a -> a -> Property
=== Point curve
a)
    , forall a. Testable a => TestName -> a -> TestTree
testProperty
        TestName
"addition associative"
        (forall a.
(Show a, Eq a) =>
(a -> a -> a) -> a -> a -> a -> Property
testAssoc (forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
BLS.blsAddOrDouble :: BLS.Point curve -> BLS.Point curve -> BLS.Point curve))
    , forall a. Testable a => TestName -> a -> TestTree
testProperty
        TestName
"addition commutative"
        (forall a. (Show a, Eq a) => (a -> a -> a) -> a -> a -> Property
testCommut (forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
BLS.blsAddOrDouble :: BLS.Point curve -> BLS.Point curve -> BLS.Point curve))
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"adding negation yields infinity" (forall curve. BLS curve => Point curve -> Bool
testAddNegYieldsInf @curve)
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"round-trip serialization" forall a b. (a -> b) -> a -> b
$
        forall p a err.
(Show p, Show err, Eq p, Eq err) =>
(p -> a) -> (a -> Either err p) -> p -> Property
testRoundTripEither @(BLS.Point curve) forall curve. BLS curve => Point curve -> ByteString
BLS.blsSerialize forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsDeserialize
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"round-trip compression" forall a b. (a -> b) -> a -> b
$
        forall p a err.
(Show p, Show err, Eq p, Eq err) =>
(p -> a) -> (a -> Either err p) -> p -> Property
testRoundTripEither @(BLS.Point curve) forall curve. BLS curve => Point curve -> ByteString
BLS.blsCompress forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"mult by p is inf" forall a b. (a -> b) -> a -> b
$ \(Point curve
a :: BLS.Point curve) ->
        forall curve. BLS curve => Point curve -> Bool
BLS.blsIsInf (forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
a Integer
BLS.scalarPeriod)
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"mult by p+1 is identity" forall a b. (a -> b) -> a -> b
$ \(Point curve
a :: BLS.Point curve) ->
        forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
a (Integer
BLS.scalarPeriod forall a. Num a => a -> a -> a
+ Integer
1) forall a. (Eq a, Show a) => a -> a -> Property
=== Point curve
a
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"scalar mult associative" forall a b. (a -> b) -> a -> b
$ \(Point curve
a :: BLS.Point curve) (BigInteger Integer
b) (BigInteger Integer
c) ->
        forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult (forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
a Integer
b) Integer
c forall a. (Eq a, Show a) => a -> a -> Property
=== forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult (forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
a Integer
c) Integer
b
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"scalar mult distributive left" forall a b. (a -> b) -> a -> b
$ \(Point curve
a :: BLS.Point curve) (BigInteger Integer
b) (BigInteger Integer
c) ->
        forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
a (Integer
b forall a. Num a => a -> a -> a
+ Integer
c) forall a. (Eq a, Show a) => a -> a -> Property
=== forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
BLS.blsAddOrDouble (forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
a Integer
b) (forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
a Integer
c)
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"scalar mult distributive right" forall a b. (a -> b) -> a -> b
$ \(Point curve
a :: BLS.Point curve) (Point curve
b :: BLS.Point curve) (BigInteger Integer
c) ->
        forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult (forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
BLS.blsAddOrDouble Point curve
a Point curve
b) Integer
c forall a. (Eq a, Show a) => a -> a -> Property
=== forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
BLS.blsAddOrDouble (forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
a Integer
c) (forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
b Integer
c)
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"mult by zero is inf" forall a b. (a -> b) -> a -> b
$ \(Point curve
a :: BLS.Point curve) ->
        forall curve. BLS curve => Point curve -> Bool
BLS.blsIsInf (forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
a Integer
0)
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"mult by -1 is equal to neg" forall a b. (a -> b) -> a -> b
$ \(Point curve
a :: BLS.Point curve) ->
        forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
a (-Integer
1) forall a. (Eq a, Show a) => a -> a -> Property
=== forall curve. BLS curve => Point curve -> Point curve
BLS.blsNeg Point curve
a
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"modular multiplication" forall a b. (a -> b) -> a -> b
$ \(BigInteger Integer
a) (BigInteger Integer
b) (Point curve
p :: BLS.Point curve) ->
        forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
p Integer
a forall a. (Eq a, Show a) => a -> a -> Property
=== forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
p (Integer
a forall a. Num a => a -> a -> a
+ Integer
b forall a. Num a => a -> a -> a
* Integer
BLS.scalarPeriod)
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"repeated addition" (forall curve. BLS curve => Int -> Point curve -> Property
prop_repeatedAddition @curve)
    , TestName -> Assertion -> TestTree
testCase TestName
"zero is inf" forall a b. (a -> b) -> a -> b
$ HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
"Zero is at infinity" (forall curve. BLS curve => Point curve -> Bool
BLS.blsIsInf (forall curve. BLS curve => Point curve
BLS.blsZero @curve))
    ]

testPT :: String -> TestTree
testPT :: TestName -> TestTree
testPT TestName
name =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
name
    [ forall a. Testable a => TestName -> a -> TestTree
testProperty
        TestName
"mult associative"
        (forall a.
(Show a, Eq a) =>
(a -> a -> a) -> a -> a -> a -> Property
testAssoc PT -> PT -> PT
BLS.ptMult)
    , forall a. Testable a => TestName -> a -> TestTree
testProperty
        TestName
"mult commutative"
        (forall a. (Show a, Eq a) => (a -> a -> a) -> a -> a -> Property
testCommut PT -> PT -> PT
BLS.ptMult)
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"self-equality" (\(PT
a :: BLS.PT) -> PT
a forall a. (Eq a, Show a) => a -> a -> Property
=== PT
a)
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"self-final-verify" (\(PT
a :: BLS.PT) -> PT -> PT -> Bool
BLS.ptFinalVerify PT
a PT
a)
    ]

testPairing :: String -> TestTree
testPairing :: TestName -> TestTree
testPairing TestName
name =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
name
    [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"identity" forall a b. (a -> b) -> a -> b
$ \Point1
a Point2
b ->
        (Point1, Point2) -> (Point1, Point2) -> Bool
pairingCheck
          (Point1
a, Point2
b)
          (Point1
a, Point2
b)
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"simple" forall a b. (a -> b) -> a -> b
$ \Integer
a Point1
p Point2
q ->
        (Point1, Point2) -> (Point1, Point2) -> Bool
pairingCheck
          (forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point1
p Integer
a, Point2
q)
          (Point1
p, forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point2
q Integer
a)
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"crossover" forall a b. (a -> b) -> a -> b
$ \Integer
a Integer
b Point1
p Point2
q ->
        (Point1, Point2) -> (Point1, Point2) -> Bool
pairingCheck
          (forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point1
p Integer
a, forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point2
q Integer
b)
          (forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point1
p Integer
b, forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point2
q Integer
a)
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"shift" forall a b. (a -> b) -> a -> b
$ \Integer
a Integer
b Point1
p Point2
q ->
        (Point1, Point2) -> (Point1, Point2) -> Bool
pairingCheck
          (forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point1
p (Integer
a forall a. Num a => a -> a -> a
* Integer
b), Point2
q)
          (forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point1
p Integer
a, forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point2
q Integer
b)
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"three pairings" Integer -> Integer -> Point1 -> Point2 -> Bool
prop_threePairings
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"four pairings" Point1 -> Point1 -> Point1 -> Point2 -> Bool
prop_fourPairings
    , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"finalVerify fails on random inputs" Point1 -> Point1 -> Point2 -> Point2 -> Property
prop_randomFailsFinalVerify
    ]
  where
    pairingCheck :: (Point1, Point2) -> (Point1, Point2) -> Bool
pairingCheck (Point1
a, Point2
b) (Point1
c, Point2
d) = PT -> PT -> Bool
BLS.ptFinalVerify (Point1 -> Point2 -> PT
BLS.millerLoop Point1
a Point2
b) (Point1 -> Point2 -> PT
BLS.millerLoop Point1
c Point2
d)

loadHexFile :: String -> IO [BS.ByteString]
loadHexFile :: TestName -> IO [ByteString]
loadHexFile TestName
filename = do
  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => TestName -> a
error forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either TestName ByteString
Base16.decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
BS8.filter (forall a. Eq a => a -> a -> Bool
/= Char
'\r')) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BS8.lines forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TestName -> IO ByteString
BS.readFile TestName
filename

testVectors :: String -> TestTree
testVectors :: TestName -> TestTree
testVectors TestName
name =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
name
    [ TestName -> TestTree
testVectorPairings TestName
"pairings"
    , TestName -> TestTree
testVectorOperations TestName
"operations"
    , TestName -> TestTree
testVectorSerDe TestName
"serialization/compression"
    , TestName -> TestTree
testVectorSigAug TestName
"signature"
    , TestName -> TestTree
testVectorLargeDst TestName
"large-dst"
    ]

testVectorPairings :: String -> TestTree
testVectorPairings :: TestName -> TestTree
testVectorPairings TestName
name =
  TestName -> Assertion -> TestTree
testCase TestName
name forall a b. (a -> b) -> a -> b
$ do
    [ ByteString
p_raw
      , ByteString
aP_raw
      , ByteString
bP_raw
      , ByteString
apbP_raw
      , ByteString
axbP_raw
      , ByteString
q_raw
      , ByteString
aQ_raw
      , ByteString
bQ_raw
      , ByteString
apbQ_raw
      , ByteString
axbQ_raw
      ] <-
      TestName -> IO [ByteString]
loadHexFile forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TestName -> IO TestName
getDataFileName TestName
"bls12-381-test-vectors/test_vectors/pairing_test_vectors"

    Point1
p <- forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError forall a b. (a -> b) -> a -> b
$ forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
p_raw
    Point2
q <- forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError forall a b. (a -> b) -> a -> b
$ forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
q_raw
    Point1
aP <- forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError forall a b. (a -> b) -> a -> b
$ forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
aP_raw
    Point2
aQ <- forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError forall a b. (a -> b) -> a -> b
$ forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
aQ_raw
    Point1
bP <- forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError forall a b. (a -> b) -> a -> b
$ forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
bP_raw
    Point2
bQ <- forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError forall a b. (a -> b) -> a -> b
$ forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
bQ_raw
    Point1
apbP <- forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError forall a b. (a -> b) -> a -> b
$ forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
apbP_raw
    Point1
axbP <- forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError forall a b. (a -> b) -> a -> b
$ forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
axbP_raw
    Point2
apbQ <- forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError forall a b. (a -> b) -> a -> b
$ forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
apbQ_raw
    Point2
axbQ <- forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError forall a b. (a -> b) -> a -> b
$ forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
axbQ_raw

    HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
"e([a]P, Q) = e(P, [a]Q)" forall a b. (a -> b) -> a -> b
$
      PT -> PT -> Bool
BLS.ptFinalVerify
        (Point1 -> Point2 -> PT
BLS.millerLoop Point1
aP Point2
q)
        (Point1 -> Point2 -> PT
BLS.millerLoop Point1
p Point2
aQ)
    HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
"e([a]P, [b]Q) = e([b]P, [a]Q)" forall a b. (a -> b) -> a -> b
$
      PT -> PT -> Bool
BLS.ptFinalVerify
        (Point1 -> Point2 -> PT
BLS.millerLoop Point1
aP Point2
bQ)
        (Point1 -> Point2 -> PT
BLS.millerLoop Point1
bP Point2
aQ)
    HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
"e([a]P, [b]Q) = e([a * b]P, Q)" forall a b. (a -> b) -> a -> b
$
      PT -> PT -> Bool
BLS.ptFinalVerify
        (Point1 -> Point2 -> PT
BLS.millerLoop Point1
aP Point2
bQ)
        (Point1 -> Point2 -> PT
BLS.millerLoop Point1
axbP Point2
q)
    HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
"e([a]P, Q) * e([b]P, Q) = e([a + b]P, Q)" forall a b. (a -> b) -> a -> b
$
      PT -> PT -> Bool
BLS.ptFinalVerify
        (PT -> PT -> PT
BLS.ptMult (Point1 -> Point2 -> PT
BLS.millerLoop Point1
aP Point2
q) (Point1 -> Point2 -> PT
BLS.millerLoop Point1
bP Point2
q))
        (Point1 -> Point2 -> PT
BLS.millerLoop Point1
apbP Point2
q)
    HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
"e([a]P, [b]Q) = e(P, [a * b]Q)" forall a b. (a -> b) -> a -> b
$
      PT -> PT -> Bool
BLS.ptFinalVerify
        (Point1 -> Point2 -> PT
BLS.millerLoop Point1
aP Point2
bQ)
        (Point1 -> Point2 -> PT
BLS.millerLoop Point1
p Point2
axbQ)
    HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
"e(P, [a]Q) * e(P, [b]Q) = e(P, [a + b]Q)" forall a b. (a -> b) -> a -> b
$
      PT -> PT -> Bool
BLS.ptFinalVerify
        (PT -> PT -> PT
BLS.ptMult (Point1 -> Point2 -> PT
BLS.millerLoop Point1
p Point2
aQ) (Point1 -> Point2 -> PT
BLS.millerLoop Point1
p Point2
bQ))
        (Point1 -> Point2 -> PT
BLS.millerLoop Point1
p Point2
apbQ)

testVectorOperations :: String -> TestTree
testVectorOperations :: TestName -> TestTree
testVectorOperations TestName
name =
  TestName -> Assertion -> TestTree
testCase TestName
name forall a b. (a -> b) -> a -> b
$ do
    [ ByteString
g1p_raw
      , ByteString
g1q_raw
      , ByteString
g1add_raw
      , ByteString
g1sub_raw
      , ByteString
g1mul_raw
      , ByteString
g1neg_raw
      , ByteString
g2p_raw
      , ByteString
g2q_raw
      , ByteString
g2add_raw
      , ByteString
g2sub_raw
      , ByteString
g2mul_raw
      , ByteString
g2neg_raw
      ] <-
      TestName -> IO [ByteString]
loadHexFile forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TestName -> IO TestName
getDataFileName TestName
"bls12-381-test-vectors/test_vectors/ec_operations_test_vectors"

    let scalar :: Integer
scalar = Integer
0x40df499974f62e2f268cd5096b0d952073900054122ffce0a27c9d96932891a5
    Point1
g1p :: BLS.Point1 <- forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError forall a b. (a -> b) -> a -> b
$ forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
g1p_raw
    Point1
g1q :: BLS.Point1 <- forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError forall a b. (a -> b) -> a -> b
$ forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
g1q_raw
    Point1
g1add :: BLS.Point1 <- forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError forall a b. (a -> b) -> a -> b
$ forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
g1add_raw
    Point1
g1sub :: BLS.Point1 <- forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError forall a b. (a -> b) -> a -> b
$ forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
g1sub_raw
    Point1
g1mul :: BLS.Point1 <- forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError forall a b. (a -> b) -> a -> b
$ forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
g1mul_raw
    Point1
g1neg :: BLS.Point1 <- forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError forall a b. (a -> b) -> a -> b
$ forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
g1neg_raw
    Point2
g2p :: BLS.Point2 <- forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError forall a b. (a -> b) -> a -> b
$ forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
g2p_raw
    Point2
g2q :: BLS.Point2 <- forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError forall a b. (a -> b) -> a -> b
$ forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
g2q_raw
    Point2
g2add :: BLS.Point2 <- forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError forall a b. (a -> b) -> a -> b
$ forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
g2add_raw
    Point2
g2sub :: BLS.Point2 <- forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError forall a b. (a -> b) -> a -> b
$ forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
g2sub_raw
    Point2
g2mul :: BLS.Point2 <- forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError forall a b. (a -> b) -> a -> b
$ forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
g2mul_raw
    Point2
g2neg :: BLS.Point2 <- forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError forall a b. (a -> b) -> a -> b
$ forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
g2neg_raw

    forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual
      TestName
"g1 add"
      Point1
g1add
      (forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
BLS.blsAddOrDouble Point1
g1p Point1
g1q)
    forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual
      TestName
"g1 sub"
      Point1
g1sub
      (forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
BLS.blsAddOrDouble Point1
g1p (forall curve. BLS curve => Point curve -> Point curve
BLS.blsNeg Point1
g1q))
    forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual
      TestName
"g1 mul"
      Point1
g1mul
      (forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point1
g1q Integer
scalar)
    forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual
      TestName
"g1 neg"
      Point1
g1neg
      (forall curve. BLS curve => Point curve -> Point curve
BLS.blsNeg Point1
g1p)

    forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual
      TestName
"g2 add"
      Point2
g2add
      (forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
BLS.blsAddOrDouble Point2
g2p Point2
g2q)
    forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual
      TestName
"g2 sub"
      Point2
g2sub
      (forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
BLS.blsAddOrDouble Point2
g2p (forall curve. BLS curve => Point curve -> Point curve
BLS.blsNeg Point2
g2q))
    forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual
      TestName
"g2 mul"
      Point2
g2mul
      (forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point2
g2q Integer
scalar)
    forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual
      TestName
"g2 neg"
      Point2
g2neg
      (forall curve. BLS curve => Point curve -> Point curve
BLS.blsNeg Point2
g2p)

testVectorSerDe :: String -> TestTree
testVectorSerDe :: TestName -> TestTree
testVectorSerDe TestName
name =
  TestName -> Assertion -> TestTree
testCase TestName
name forall a b. (a -> b) -> a -> b
$ do
    [ ByteString
g1UncompNotOnCurve
      , ByteString
g1CompNotOnCurve
      , ByteString
g1CompNotInGroup
      , ByteString
g1UncompNotInGroup
      , ByteString
g2UncompNotOnCurve
      , ByteString
g2CompNotOnCurve
      , ByteString
g2CompNotInGroup
      , ByteString
g2UncompNotInGroup
      ] <-
      TestName -> IO [ByteString]
loadHexFile forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TestName -> IO TestName
getDataFileName TestName
"bls12-381-test-vectors/test_vectors/serde_test_vectors"

    forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual
      TestName
"g1UncompNotOnCurve"
      (forall a b. a -> Either a b
Left BLSTError
BLS.BLST_POINT_NOT_ON_CURVE)
      (forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsDeserialize ByteString
g1UncompNotOnCurve :: Either BLS.BLSTError BLS.Point1)

    forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual
      TestName
"g1CompNotInGroup"
      (forall a b. a -> Either a b
Left BLSTError
BLS.BLST_POINT_NOT_IN_GROUP)
      (forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
g1CompNotInGroup :: Either BLS.BLSTError BLS.Point1)

    forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual
      TestName
"g1CompNotOnCurve"
      (forall a b. a -> Either a b
Left BLSTError
BLS.BLST_POINT_NOT_ON_CURVE)
      (forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
g1CompNotOnCurve :: Either BLS.BLSTError BLS.Point1)

    forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual
      TestName
"g1UncompNotInGroup"
      (forall a b. a -> Either a b
Left BLSTError
BLS.BLST_POINT_NOT_IN_GROUP)
      (forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsDeserialize ByteString
g1UncompNotInGroup :: Either BLS.BLSTError BLS.Point1)

    forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual
      TestName
"g2UncompNotOnCurve"
      (forall a b. a -> Either a b
Left BLSTError
BLS.BLST_POINT_NOT_ON_CURVE)
      (forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsDeserialize ByteString
g2UncompNotOnCurve :: Either BLS.BLSTError BLS.Point2)

    forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual
      TestName
"g2CompNotInGroup"
      (forall a b. a -> Either a b
Left BLSTError
BLS.BLST_POINT_NOT_IN_GROUP)
      (forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
g2CompNotInGroup :: Either BLS.BLSTError BLS.Point2)

    forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual
      TestName
"g2CompNotOnCurve"
      (forall a b. a -> Either a b
Left BLSTError
BLS.BLST_POINT_NOT_ON_CURVE)
      (forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
g2CompNotOnCurve :: Either BLS.BLSTError BLS.Point2)

    forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual
      TestName
"g2UncompNotInGroup"
      (forall a b. a -> Either a b
Left BLSTError
BLS.BLST_POINT_NOT_IN_GROUP)
      (forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsDeserialize ByteString
g2UncompNotInGroup :: Either BLS.BLSTError BLS.Point2)

testVectorSigAug :: String -> TestTree
testVectorSigAug :: TestName -> TestTree
testVectorSigAug TestName
name =
  TestName -> Assertion -> TestTree
testCase TestName
name forall a b. (a -> b) -> a -> b
$ do
    [ByteString
sig_raw, ByteString
pk_raw] <-
      TestName -> IO [ByteString]
loadHexFile forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TestName -> IO TestName
getDataFileName TestName
"bls12-381-test-vectors/test_vectors/bls_sig_aug_test_vectors"
    let dst :: ByteString
dst = ByteString
"BLS_SIG_BLS12381G2_XMD:SHA-256_SSWU_RO_NUL_"
    let msg :: ByteString
msg = ByteString
"blst is such a blast"
    let aug :: ByteString
aug = ByteString
"Random value for test aug. "
    let hashedMsg :: Point1
hashedMsg = forall curve.
BLS curve =>
ByteString -> Maybe ByteString -> Maybe ByteString -> Point curve
BLS.blsHash (ByteString
aug forall a. Semigroup a => a -> a -> a
<> ByteString
msg) (forall a. a -> Maybe a
Just ByteString
dst) forall a. Maybe a
Nothing
    Point1
sig <- forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError forall a b. (a -> b) -> a -> b
$ forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
sig_raw
    Point2
pk <- forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError forall a b. (a -> b) -> a -> b
$ forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
pk_raw

    HasCallStack => TestName -> Bool -> Assertion
assertBool TestName
"valid signature" forall a b. (a -> b) -> a -> b
$
      PT -> PT -> Bool
BLS.ptFinalVerify
        (Point1 -> Point2 -> PT
BLS.millerLoop Point1
sig forall curve. BLS curve => Point curve
BLS.blsGenerator)
        (Point1 -> Point2 -> PT
BLS.millerLoop Point1
hashedMsg Point2
pk)

testVectorLargeDst :: String -> TestTree
testVectorLargeDst :: TestName -> TestTree
testVectorLargeDst TestName
name =
  TestName -> Assertion -> TestTree
testCase TestName
name forall a b. (a -> b) -> a -> b
$ do
    [ByteString
msg_raw, ByteString
large_dst_raw, ByteString
output_raw] <-
      TestName -> IO [ByteString]
loadHexFile forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TestName -> IO TestName
getDataFileName TestName
"bls12-381-test-vectors/test_vectors/h2c_large_dst"
    let prefix :: ByteString
prefix = ByteString
"H2C-OVERSIZE-DST-"
    let dst_sha :: ByteString
dst_sha = forall h (proxy :: * -> *).
HashAlgorithm h =>
proxy h -> ByteString -> ByteString
digest (forall {k} (t :: k). Proxy t
Proxy @SHA256) (ByteString
prefix forall a. Semigroup a => a -> a -> a
<> ByteString
large_dst_raw)
    let hashedMsg :: Point1
hashedMsg = forall curve.
BLS curve =>
ByteString -> Maybe ByteString -> Maybe ByteString -> Point curve
BLS.blsHash ByteString
msg_raw (forall a. a -> Maybe a
Just ByteString
dst_sha) forall a. Maybe a
Nothing
    Point1
expected_output :: BLS.Point1 <- forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError forall a b. (a -> b) -> a -> b
$ forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
output_raw

    forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual
      TestName
"expected hash output"
      Point1
hashedMsg
      Point1
expected_output

testAssoc :: (Show a, Eq a) => (a -> a -> a) -> a -> a -> a -> Property
testAssoc :: forall a.
(Show a, Eq a) =>
(a -> a -> a) -> a -> a -> a -> Property
testAssoc a -> a -> a
f a
a a
b a
c =
  a -> a -> a
f a
a (a -> a -> a
f a
b a
c) forall a. (Eq a, Show a) => a -> a -> Property
=== a -> a -> a
f (a -> a -> a
f a
a a
b) a
c

testCommut :: (Show a, Eq a) => (a -> a -> a) -> a -> a -> Property
testCommut :: forall a. (Show a, Eq a) => (a -> a -> a) -> a -> a -> Property
testCommut a -> a -> a
f a
a a
b =
  a -> a -> a
f a
a a
b forall a. (Eq a, Show a) => a -> a -> Property
=== a -> a -> a
f a
b a
a

prop_repeatedAddition :: forall curve. BLS.BLS curve => Int -> BLS.Point curve -> Property
prop_repeatedAddition :: forall curve. BLS curve => Int -> Point curve -> Property
prop_repeatedAddition Int
a Point curve
p = forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
p (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a) forall a. (Eq a, Show a) => a -> a -> Property
=== Int -> Point curve -> Point curve
repeatedAdd Int
a Point curve
p
  where
    repeatedAdd :: Int -> BLS.Point curve -> BLS.Point curve
    repeatedAdd :: Int -> Point curve -> Point curve
repeatedAdd Int
scalar Point curve
point =
      forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
BLS.blsAddOrDouble forall curve. BLS curve => Point curve
BLS.blsZero forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate (forall a. Num a => a -> a
abs Int
scalar) (forall curve. BLS curve => Point curve -> Bool -> Point curve
BLS.blsCneg Point curve
point (Int
scalar forall a. Ord a => a -> a -> Bool
< Int
0))

testAddNegYieldsInf ::
  forall curve.
  BLS.BLS curve =>
  BLS.Point curve -> Bool
testAddNegYieldsInf :: forall curve. BLS curve => Point curve -> Bool
testAddNegYieldsInf Point curve
p =
  forall curve. BLS curve => Point curve -> Bool
BLS.blsIsInf (forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
BLS.blsAddOrDouble Point curve
p (forall curve. BLS curve => Point curve -> Point curve
BLS.blsNeg Point curve
p))

testRoundTripEither ::
  forall p a err.
  (Show p, Show err, Eq p, Eq err) =>
  (p -> a) ->
  (a -> Either err p) ->
  p ->
  Property
testRoundTripEither :: forall p a err.
(Show p, Show err, Eq p, Eq err) =>
(p -> a) -> (a -> Either err p) -> p -> Property
testRoundTripEither p -> a
encode a -> Either err p
decode p
p =
  forall a b. b -> Either a b
Right p
p forall a. (Eq a, Show a) => a -> a -> Property
=== (a -> Either err p
decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> a
encode) p
p

prop_threePairings :: Integer -> Integer -> BLS.Point1 -> BLS.Point2 -> Bool
prop_threePairings :: Integer -> Integer -> Point1 -> Point2 -> Bool
prop_threePairings Integer
a Integer
b Point1
p Point2
q = PT -> PT -> Bool
BLS.ptFinalVerify PT
tt PT
t3
  where
    t1 :: PT
t1 = Point1 -> Point2 -> PT
BLS.millerLoop (forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point1
p Integer
a) Point2
q
    t2 :: PT
t2 = Point1 -> Point2 -> PT
BLS.millerLoop Point1
p (forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point2
q Integer
b)
    t3 :: PT
t3 = Point1 -> Point2 -> PT
BLS.millerLoop (forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point1
p (Integer
a forall a. Num a => a -> a -> a
+ Integer
b)) Point2
q
    tt :: PT
tt = PT -> PT -> PT
BLS.ptMult PT
t1 PT
t2

prop_fourPairings :: BLS.Point1 -> BLS.Point1 -> BLS.Point1 -> BLS.Point2 -> Bool
prop_fourPairings :: Point1 -> Point1 -> Point1 -> Point2 -> Bool
prop_fourPairings Point1
a1 Point1
a2 Point1
a3 Point2
b = PT -> PT -> Bool
BLS.ptFinalVerify PT
tt PT
t4
  where
    t1 :: PT
t1 = Point1 -> Point2 -> PT
BLS.millerLoop Point1
a1 Point2
b
    t2 :: PT
t2 = Point1 -> Point2 -> PT
BLS.millerLoop Point1
a2 Point2
b
    t3 :: PT
t3 = Point1 -> Point2 -> PT
BLS.millerLoop Point1
a3 Point2
b
    t4 :: PT
t4 = Point1 -> Point2 -> PT
BLS.millerLoop (forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
BLS.blsAddOrDouble (forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
BLS.blsAddOrDouble Point1
a1 Point1
a2) Point1
a3) Point2
b
    tt :: PT
tt = PT -> PT -> PT
BLS.ptMult (PT -> PT -> PT
BLS.ptMult PT
t1 PT
t2) PT
t3

prop_randomFailsFinalVerify :: BLS.Point1 -> BLS.Point1 -> BLS.Point2 -> BLS.Point2 -> Property
prop_randomFailsFinalVerify :: Point1 -> Point1 -> Point2 -> Point2 -> Property
prop_randomFailsFinalVerify Point1
a Point1
b Point2
c Point2
d =
  Point1
a forall a. Eq a => a -> a -> Bool
/= Point1
b Bool -> Bool -> Bool
&& Point2
c forall a. Eq a => a -> a -> Bool
/= Point2
d forall prop. Testable prop => Bool -> prop -> Property
==>
    PT -> PT -> Bool
BLS.ptFinalVerify (Point1 -> Point2 -> PT
BLS.millerLoop Point1
a Point2
c) (Point1 -> Point2 -> PT
BLS.millerLoop Point1
b Point2
d) forall a. (Eq a, Show a) => a -> a -> Property
=== Bool
False

newtype BigInteger = BigInteger Integer
  deriving (BigInteger -> BigInteger -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BigInteger -> BigInteger -> Bool
$c/= :: BigInteger -> BigInteger -> Bool
== :: BigInteger -> BigInteger -> Bool
$c== :: BigInteger -> BigInteger -> Bool
Eq, Int -> BigInteger -> ShowS
[BigInteger] -> ShowS
BigInteger -> TestName
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
showList :: [BigInteger] -> ShowS
$cshowList :: [BigInteger] -> ShowS
show :: BigInteger -> TestName
$cshow :: BigInteger -> TestName
showsPrec :: Int -> BigInteger -> ShowS
$cshowsPrec :: Int -> BigInteger -> ShowS
Show)
instance Arbitrary BigInteger where
  arbitrary :: Gen BigInteger
arbitrary = Integer -> BigInteger
BigInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasCallStack => [Gen a] -> Gen a
oneof [forall a. Arbitrary a => Gen a
arbitrary, forall a. Random a => Gen a
chooseAny, forall a. Random a => (a, a) -> Gen a
choose (-Integer
2 forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
128 :: Int), Integer
2 forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
128 :: Int))]

instance BLS.BLS curve => Arbitrary (BLS.Point curve) where
  arbitrary :: Gen (Point curve)
arbitrary = do
    [Word8]
str <- forall a. Arbitrary a => Gen a
arbitrary
    let bs :: ByteString
bs = [Word8] -> ByteString
BS.pack [Word8]
str
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall curve.
BLS curve =>
ByteString -> Maybe ByteString -> Maybe ByteString -> Point curve
BLS.blsHash ByteString
bs forall a. Maybe a
Nothing forall a. Maybe a
Nothing

instance BLS.BLS curve => Arbitrary (BLS.Affine curve) where
  arbitrary :: Gen (Affine curve)
arbitrary = forall curve. BLS curve => Point curve -> Affine curve
BLS.toAffine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary BLS.PT where
  arbitrary :: Gen PT
arbitrary = Point1 -> Point2 -> PT
BLS.millerLoop forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary

instance Show BLS.PT where
  show :: PT -> TestName
show = forall a b. a -> b -> a
const TestName
"<<<PT>>>"

instance Arbitrary BLS.Scalar where
  arbitrary :: Gen Scalar
arbitrary =
    (ByteString -> Either BLSTError Scalar
BLS.scalarFromBS forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary)
      forall a b. Gen a -> (a -> Maybe b) -> Gen b
`suchThatMap` ( \case
                        Left BLSTError
_ -> forall a. Maybe a
Nothing
                        Right Scalar
v -> forall a. a -> Maybe a
Just Scalar
v
                    )

instance Show BLS.Scalar where
  show :: Scalar -> TestName
show = forall a. Show a => a -> TestName
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scalar -> ByteString
BLS.scalarToBS

instance BLS.BLS curve => Show (BLS.Point curve) where
  show :: Point curve -> TestName
show = forall a. Show a => a -> TestName
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall curve. BLS curve => Point curve -> ByteString
BLS.blsSerialize

instance BLS.BLS curve => Show (BLS.Affine curve) where
  show :: Affine curve -> TestName
show = forall a. Show a => a -> TestName
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall curve. BLS curve => Affine curve -> Point curve
BLS.fromAffine