{-# 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 (frequency, 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"
        , TestName -> Proxy Curve1 -> TestTree
forall curve. BLS curve => TestName -> Proxy curve -> TestTree
testBLSCurve TestName
"Curve 1" (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @BLS.Curve1)
        , TestName -> Proxy Curve2 -> TestTree
forall curve. BLS curve => TestName -> Proxy curve -> TestTree
testBLSCurve TestName
"Curve 2" (forall t. Proxy t
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
    [ TestName -> (Integer -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Integer / C-String 32 round-trip" ((Integer -> Property) -> TestTree)
-> (Integer -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
        \Integer
n ->
          Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
            Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< (Integer
1 Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
32 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
8) Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
              Integer
n Integer -> Integer -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== IO Integer -> Integer
forall a. IO a -> a
unsafePerformIO (Int -> Integer -> (Ptr CChar -> Int -> IO Integer) -> IO Integer
forall a. Int -> Integer -> (Ptr CChar -> Int -> IO a) -> IO a
BLS.integerAsCStrL Int
32 Integer
n Ptr CChar -> Int -> IO Integer
BLS.cstrToInteger)
    , TestName -> (Int -> [Word8] -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"padBS min length" ((Int -> [Word8] -> Bool) -> TestTree)
-> (Int -> [Word8] -> Bool) -> TestTree
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)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n
    , TestName -> ([Word8] -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"padBS adds zeroes to front" (([Word8] -> Property) -> TestTree)
-> ([Word8] -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ \[Word8]
bsw ->
        HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index (Int -> ByteString -> ByteString
BLS.padBS ([Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
bsw Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([Word8] -> ByteString
BS.pack [Word8]
bsw)) Int
0 Word8 -> Word8 -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Word8
0
    , TestName -> Assertion -> TestTree
testCase TestName
"integerToBS" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
        TestName -> ByteString -> ByteString -> Assertion
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)
        TestName -> ByteString -> ByteString -> Assertion
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
    [ TestName -> (Scalar -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"self-equality" ((Scalar -> Property) -> TestTree)
-> (Scalar -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
        \(Scalar
a :: BLS.Scalar) -> Scalar
a Scalar -> Scalar -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Scalar
a
    , TestName -> (Scalar -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"to/from BS round-trip" ((Scalar -> Property) -> TestTree)
-> (Scalar -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
        \Scalar
s -> Scalar -> Either BLSTError Scalar
forall a b. b -> Either a b
Right Scalar
s Either BLSTError Scalar -> Either BLSTError Scalar -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (ByteString -> Either BLSTError Scalar
BLS.scalarFromBS (ByteString -> Either BLSTError Scalar)
-> (Scalar -> ByteString) -> Scalar -> Either BLSTError Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scalar -> ByteString
BLS.scalarToBS (Scalar -> Either BLSTError Scalar)
-> Scalar -> Either BLSTError Scalar
forall a b. (a -> b) -> a -> b
$ Scalar
s)
    , TestName -> (Scalar -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"non-negative" ((Scalar -> Bool) -> TestTree) -> (Scalar -> Bool) -> TestTree
forall a b. (a -> b) -> a -> b
$
        \Scalar
s -> (IO Integer -> Integer
forall a. IO a -> a
unsafePerformIO (IO Integer -> Integer)
-> (Scalar -> IO Integer) -> Scalar -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scalar -> IO Integer
BLS.scalarToInteger (Scalar -> Integer) -> Scalar -> Integer
forall a b. (a -> b) -> a -> b
$ Scalar
s) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0
    , TestName -> (Scalar -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"to/from Integer round-trip" ((Scalar -> Property) -> TestTree)
-> (Scalar -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
        \Scalar
s -> Scalar
s Scalar -> Scalar -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== IO Scalar -> Scalar
forall a. IO a -> a
unsafePerformIO (Scalar -> IO Integer
BLS.scalarToInteger Scalar
s IO Integer -> (Integer -> IO Scalar) -> IO Scalar
forall a b. IO a -> (a -> IO b) -> IO b
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" (Assertion -> TestTree) -> Assertion -> TestTree
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 -> TestName -> IO Scalar
forall a. HasCallStack => TestName -> a
error (BLSTError -> TestName
forall a. Show a => a -> TestName
show BLSTError
err)
          Right Scalar
x -> Scalar -> IO Scalar
forall a. a -> IO a
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
        TestName -> Integer -> Integer -> Assertion
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        HasCallStack => TestName -> Bool -> Assertion
TestName -> Bool -> Assertion
assertBool TestName
"" (Point curve -> Bool
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        HasCallStack => TestName -> Bool -> Assertion
TestName -> Bool -> Assertion
assertBool TestName
"" (Point curve -> Bool
forall curve. BLS curve => Point curve -> Bool
BLS.blsInGroup (Point curve -> Point curve
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        HasCallStack => TestName -> Bool -> Assertion
TestName -> Bool -> Assertion
assertBool
          TestName
""
          (Point curve -> Bool
forall curve. BLS curve => Point curve -> Bool
BLS.blsInGroup (Point curve -> Point curve -> Point curve
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)))
    , TestName -> (Point curve -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"in group" (forall curve. BLS curve => Point curve -> Bool
BLS.blsInGroup @curve)
    , TestName -> (Point curve -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"neg in group" (forall curve. BLS curve => Point curve -> Bool
BLS.blsInGroup @curve (Point curve -> Bool)
-> (Point curve -> Point curve) -> Point curve -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point curve -> Point curve
forall curve. BLS curve => Point curve -> Point curve
BLS.blsNeg)
    , TestName -> (Point curve -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"self-equality" (\(Point curve
a :: BLS.Point curve) -> Point curve
a Point curve -> Point curve -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Point curve
a)
    , TestName -> (Point curve -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"double negation" (\(Point curve
a :: BLS.Point curve) -> Point curve
a Point curve -> Point curve -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Point curve -> Point curve
forall curve. BLS curve => Point curve -> Point curve
BLS.blsNeg (Point curve -> Point curve
forall curve. BLS curve => Point curve -> Point curve
BLS.blsNeg Point curve
a))
    , TestName -> (Point curve -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty
        TestName
"adding infinity yields equality"
        (\(Point curve
a :: BLS.Point curve) -> Point curve -> Point curve -> 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) Point curve -> Point curve -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Point curve
a)
    , TestName
-> (Point curve -> Point curve -> Point curve -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty
        TestName
"addition associative"
        ((Point curve -> Point curve -> Point curve)
-> Point curve -> Point curve -> Point curve -> Property
forall a.
(Show a, Eq a) =>
(a -> a -> a) -> a -> a -> a -> Property
testAssoc (Point curve -> Point curve -> Point curve
forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
BLS.blsAddOrDouble :: BLS.Point curve -> BLS.Point curve -> BLS.Point curve))
    , TestName -> (Point curve -> Point curve -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty
        TestName
"addition commutative"
        ((Point curve -> Point curve -> Point curve)
-> Point curve -> Point curve -> Property
forall a. (Show a, Eq a) => (a -> a -> a) -> a -> a -> Property
testCommut (Point curve -> Point curve -> Point curve
forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
BLS.blsAddOrDouble :: BLS.Point curve -> BLS.Point curve -> BLS.Point curve))
    , TestName -> (Point curve -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"adding negation yields infinity" (forall curve. BLS curve => Point curve -> Bool
testAddNegYieldsInf @curve)
    , TestName -> (Point curve -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"round-trip serialization" ((Point curve -> Property) -> TestTree)
-> (Point curve -> Property) -> TestTree
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) Point curve -> ByteString
forall curve. BLS curve => Point curve -> ByteString
BLS.blsSerialize ByteString -> Either BLSTError (Point curve)
forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsDeserialize
    , TestName -> (Point curve -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"round-trip compression" ((Point curve -> Property) -> TestTree)
-> (Point curve -> Property) -> TestTree
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) Point curve -> ByteString
forall curve. BLS curve => Point curve -> ByteString
BLS.blsCompress ByteString -> Either BLSTError (Point curve)
forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress
    , TestName -> (Point curve -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"mult by p is inf" ((Point curve -> Bool) -> TestTree)
-> (Point curve -> Bool) -> TestTree
forall a b. (a -> b) -> a -> b
$ \(Point curve
a :: BLS.Point curve) ->
        Point curve -> Bool
forall curve. BLS curve => Point curve -> Bool
BLS.blsIsInf (Point curve -> Integer -> Point curve
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
a Integer
BLS.scalarPeriod)
    , TestName -> (Point curve -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"mult by p+1 is identity" ((Point curve -> Property) -> TestTree)
-> (Point curve -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ \(Point curve
a :: BLS.Point curve) ->
        Point curve -> Integer -> Point curve
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
a (Integer
BLS.scalarPeriod Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) Point curve -> Point curve -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Point curve
a
    , TestName
-> (Point curve -> BigInteger -> BigInteger -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"scalar mult associative" ((Point curve -> BigInteger -> BigInteger -> Property) -> TestTree)
-> (Point curve -> BigInteger -> BigInteger -> Property)
-> TestTree
forall a b. (a -> b) -> a -> b
$ \(Point curve
a :: BLS.Point curve) (BigInteger Integer
b) (BigInteger Integer
c) ->
        Point curve -> Integer -> Point curve
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult (Point curve -> Integer -> Point curve
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
a Integer
b) Integer
c Point curve -> Point curve -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Point curve -> Integer -> Point curve
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult (Point curve -> Integer -> Point curve
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
a Integer
c) Integer
b
    , TestName
-> (Point curve -> BigInteger -> BigInteger -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"scalar mult distributive left" ((Point curve -> BigInteger -> BigInteger -> Property) -> TestTree)
-> (Point curve -> BigInteger -> BigInteger -> Property)
-> TestTree
forall a b. (a -> b) -> a -> b
$ \(Point curve
a :: BLS.Point curve) (BigInteger Integer
b) (BigInteger Integer
c) ->
        Point curve -> Integer -> Point curve
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
a (Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
c) Point curve -> Point curve -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Point curve -> Point curve -> Point curve
forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
BLS.blsAddOrDouble (Point curve -> Integer -> Point curve
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
a Integer
b) (Point curve -> Integer -> Point curve
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
a Integer
c)
    , TestName
-> (Point curve -> Point curve -> BigInteger -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"scalar mult distributive right" ((Point curve -> Point curve -> BigInteger -> Property)
 -> TestTree)
-> (Point curve -> Point curve -> BigInteger -> Property)
-> TestTree
forall a b. (a -> b) -> a -> b
$ \(Point curve
a :: BLS.Point curve) (Point curve
b :: BLS.Point curve) (BigInteger Integer
c) ->
        Point curve -> Integer -> Point curve
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult (Point curve -> Point curve -> Point curve
forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
BLS.blsAddOrDouble Point curve
a Point curve
b) Integer
c Point curve -> Point curve -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Point curve -> Point curve -> Point curve
forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
BLS.blsAddOrDouble (Point curve -> Integer -> Point curve
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
a Integer
c) (Point curve -> Integer -> Point curve
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
b Integer
c)
    , TestName -> ([(BigInteger, Point curve)] -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"MSM matches naive approach" (([(BigInteger, Point curve)] -> Property) -> TestTree)
-> ([(BigInteger, Point curve)] -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ \([(BigInteger, Point curve)]
ssAndPs :: [(BigInteger, BLS.Point curve)]) ->
        let pairs :: [(Integer, Point curve)]
pairs = [(Integer
i, Point curve
p) | (BigInteger Integer
i, Point curve
p) <- [(BigInteger, Point curve)]
ssAndPs]
         in [(Integer, Point curve)] -> Point curve
forall curve. BLS curve => [(Integer, Point curve)] -> Point curve
BLS.blsMSM [(Integer, Point curve)]
pairs
              Point curve -> Point curve -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== ((Integer, Point curve) -> Point curve -> Point curve)
-> Point curve -> [(Integer, Point curve)] -> Point curve
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Integer
s, Point curve
p) Point curve
acc -> Point curve -> Point curve -> Point curve
forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
BLS.blsAddOrDouble Point curve
acc (Point curve -> Integer -> Point curve
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
p Integer
s)) (forall curve. BLS curve => Point curve
BLS.blsZero @curve) [(Integer, Point curve)]
pairs
    , TestName -> (Point curve -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"mult by zero is inf" ((Point curve -> Bool) -> TestTree)
-> (Point curve -> Bool) -> TestTree
forall a b. (a -> b) -> a -> b
$ \(Point curve
a :: BLS.Point curve) ->
        Point curve -> Bool
forall curve. BLS curve => Point curve -> Bool
BLS.blsIsInf (Point curve -> Integer -> Point curve
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
a Integer
0)
    , TestName -> (Point curve -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"mult by -1 is equal to neg" ((Point curve -> Property) -> TestTree)
-> (Point curve -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ \(Point curve
a :: BLS.Point curve) ->
        Point curve -> Integer -> Point curve
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
a (-Integer
1) Point curve -> Point curve -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Point curve -> Point curve
forall curve. BLS curve => Point curve -> Point curve
BLS.blsNeg Point curve
a
    , TestName
-> (BigInteger -> BigInteger -> Point curve -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"modular multiplication" ((BigInteger -> BigInteger -> Point curve -> Property) -> TestTree)
-> (BigInteger -> BigInteger -> Point curve -> Property)
-> TestTree
forall a b. (a -> b) -> a -> b
$ \(BigInteger Integer
a) (BigInteger Integer
b) (Point curve
p :: BLS.Point curve) ->
        Point curve -> Integer -> Point curve
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
p Integer
a Point curve -> Point curve -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Point curve -> Integer -> Point curve
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
p (Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
BLS.scalarPeriod)
    , TestName -> (Int -> Point curve -> Property) -> TestTree
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ HasCallStack => TestName -> Bool -> Assertion
TestName -> Bool -> Assertion
assertBool TestName
"Zero is at infinity" (Point curve -> Bool
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
    [ TestName -> (PT -> PT -> PT -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty
        TestName
"mult associative"
        ((PT -> PT -> PT) -> PT -> PT -> PT -> Property
forall a.
(Show a, Eq a) =>
(a -> a -> a) -> a -> a -> a -> Property
testAssoc PT -> PT -> PT
BLS.ptMult)
    , TestName -> (PT -> PT -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty
        TestName
"mult commutative"
        ((PT -> PT -> PT) -> PT -> PT -> Property
forall a. (Show a, Eq a) => (a -> a -> a) -> a -> a -> Property
testCommut PT -> PT -> PT
BLS.ptMult)
    , TestName -> (PT -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"self-equality" (\(PT
a :: BLS.PT) -> PT
a PT -> PT -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== PT
a)
    , TestName -> (PT -> Bool) -> TestTree
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
    [ TestName -> (Point1 -> Point2 -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"identity" ((Point1 -> Point2 -> Bool) -> TestTree)
-> (Point1 -> Point2 -> Bool) -> TestTree
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)
    , TestName -> (Integer -> Point1 -> Point2 -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"simple" ((Integer -> Point1 -> Point2 -> Bool) -> TestTree)
-> (Integer -> Point1 -> Point2 -> Bool) -> TestTree
forall a b. (a -> b) -> a -> b
$ \Integer
a Point1
p Point2
q ->
        (Point1, Point2) -> (Point1, Point2) -> Bool
pairingCheck
          (Point1 -> Integer -> Point1
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point1
p Integer
a, Point2
q)
          (Point1
p, Point2 -> Integer -> Point2
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point2
q Integer
a)
    , TestName
-> (Integer -> Integer -> Point1 -> Point2 -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"crossover" ((Integer -> Integer -> Point1 -> Point2 -> Bool) -> TestTree)
-> (Integer -> Integer -> Point1 -> Point2 -> Bool) -> TestTree
forall a b. (a -> b) -> a -> b
$ \Integer
a Integer
b Point1
p Point2
q ->
        (Point1, Point2) -> (Point1, Point2) -> Bool
pairingCheck
          (Point1 -> Integer -> Point1
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point1
p Integer
a, Point2 -> Integer -> Point2
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point2
q Integer
b)
          (Point1 -> Integer -> Point1
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point1
p Integer
b, Point2 -> Integer -> Point2
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point2
q Integer
a)
    , TestName
-> (Integer -> Integer -> Point1 -> Point2 -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"shift" ((Integer -> Integer -> Point1 -> Point2 -> Bool) -> TestTree)
-> (Integer -> Integer -> Point1 -> Point2 -> Bool) -> TestTree
forall a b. (a -> b) -> a -> b
$ \Integer
a Integer
b Point1
p Point2
q ->
        (Point1, Point2) -> (Point1, Point2) -> Bool
pairingCheck
          (Point1 -> Integer -> Point1
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point1
p (Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
b), Point2
q)
          (Point1 -> Integer -> Point1
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point1
p Integer
a, Point2 -> Integer -> Point2
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point2
q Integer
b)
    , TestName
-> (Integer -> Integer -> Point1 -> Point2 -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"three pairings" Integer -> Integer -> Point1 -> Point2 -> Bool
prop_threePairings
    , TestName
-> (Point1 -> Point1 -> Point1 -> Point2 -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"four pairings" Point1 -> Point1 -> Point1 -> Point2 -> Bool
prop_fourPairings
    , TestName
-> (BigInteger
    -> BigInteger -> BigInteger -> BigInteger -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"finalVerify fails on random inputs" BigInteger -> BigInteger -> BigInteger -> BigInteger -> 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
  (ByteString -> IO ByteString) -> [ByteString] -> IO [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((TestName -> IO ByteString)
-> (ByteString -> IO ByteString)
-> Either TestName ByteString
-> IO ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TestName -> IO ByteString
forall a. HasCallStack => TestName -> a
error ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TestName ByteString -> IO ByteString)
-> (ByteString -> Either TestName ByteString)
-> ByteString
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either TestName ByteString
Base16.decode (ByteString -> Either TestName ByteString)
-> (ByteString -> ByteString)
-> ByteString
-> Either TestName ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
BS8.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r')) ([ByteString] -> IO [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> IO [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BS8.lines (ByteString -> IO [ByteString]) -> IO ByteString -> IO [ByteString]
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 (Assertion -> TestTree) -> Assertion -> TestTree
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 (TestName -> IO [ByteString]) -> IO TestName -> IO [ByteString]
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 <- Either BLSTError Point1 -> IO Point1
forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError (Either BLSTError Point1 -> IO Point1)
-> Either BLSTError Point1 -> IO Point1
forall a b. (a -> b) -> a -> b
$ ByteString -> Either BLSTError Point1
forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
p_raw
    Point2
q <- Either BLSTError Point2 -> IO Point2
forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError (Either BLSTError Point2 -> IO Point2)
-> Either BLSTError Point2 -> IO Point2
forall a b. (a -> b) -> a -> b
$ ByteString -> Either BLSTError Point2
forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
q_raw
    Point1
aP <- Either BLSTError Point1 -> IO Point1
forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError (Either BLSTError Point1 -> IO Point1)
-> Either BLSTError Point1 -> IO Point1
forall a b. (a -> b) -> a -> b
$ ByteString -> Either BLSTError Point1
forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
aP_raw
    Point2
aQ <- Either BLSTError Point2 -> IO Point2
forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError (Either BLSTError Point2 -> IO Point2)
-> Either BLSTError Point2 -> IO Point2
forall a b. (a -> b) -> a -> b
$ ByteString -> Either BLSTError Point2
forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
aQ_raw
    Point1
bP <- Either BLSTError Point1 -> IO Point1
forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError (Either BLSTError Point1 -> IO Point1)
-> Either BLSTError Point1 -> IO Point1
forall a b. (a -> b) -> a -> b
$ ByteString -> Either BLSTError Point1
forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
bP_raw
    Point2
bQ <- Either BLSTError Point2 -> IO Point2
forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError (Either BLSTError Point2 -> IO Point2)
-> Either BLSTError Point2 -> IO Point2
forall a b. (a -> b) -> a -> b
$ ByteString -> Either BLSTError Point2
forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
bQ_raw
    Point1
apbP <- Either BLSTError Point1 -> IO Point1
forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError (Either BLSTError Point1 -> IO Point1)
-> Either BLSTError Point1 -> IO Point1
forall a b. (a -> b) -> a -> b
$ ByteString -> Either BLSTError Point1
forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
apbP_raw
    Point1
axbP <- Either BLSTError Point1 -> IO Point1
forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError (Either BLSTError Point1 -> IO Point1)
-> Either BLSTError Point1 -> IO Point1
forall a b. (a -> b) -> a -> b
$ ByteString -> Either BLSTError Point1
forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
axbP_raw
    Point2
apbQ <- Either BLSTError Point2 -> IO Point2
forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError (Either BLSTError Point2 -> IO Point2)
-> Either BLSTError Point2 -> IO Point2
forall a b. (a -> b) -> a -> b
$ ByteString -> Either BLSTError Point2
forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
apbQ_raw
    Point2
axbQ <- Either BLSTError Point2 -> IO Point2
forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError (Either BLSTError Point2 -> IO Point2)
-> Either BLSTError Point2 -> IO Point2
forall a b. (a -> b) -> a -> b
$ ByteString -> Either BLSTError Point2
forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
axbQ_raw

    HasCallStack => TestName -> Bool -> Assertion
TestName -> Bool -> Assertion
assertBool TestName
"e([a]P, Q) = e(P, [a]Q)" (Bool -> Assertion) -> Bool -> Assertion
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
TestName -> Bool -> Assertion
assertBool TestName
"e([a]P, [b]Q) = e([b]P, [a]Q)" (Bool -> Assertion) -> Bool -> Assertion
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
TestName -> Bool -> Assertion
assertBool TestName
"e([a]P, [b]Q) = e([a * b]P, Q)" (Bool -> Assertion) -> Bool -> Assertion
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
TestName -> Bool -> Assertion
assertBool TestName
"e([a]P, Q) * e([b]P, Q) = e([a + b]P, Q)" (Bool -> Assertion) -> Bool -> Assertion
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
TestName -> Bool -> Assertion
assertBool TestName
"e([a]P, [b]Q) = e(P, [a * b]Q)" (Bool -> Assertion) -> Bool -> Assertion
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
TestName -> Bool -> Assertion
assertBool TestName
"e(P, [a]Q) * e(P, [b]Q) = e(P, [a + b]Q)" (Bool -> Assertion) -> Bool -> Assertion
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 (Assertion -> TestTree) -> Assertion -> TestTree
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 (TestName -> IO [ByteString]) -> IO TestName -> IO [ByteString]
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 <- Either BLSTError Point1 -> IO Point1
forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError (Either BLSTError Point1 -> IO Point1)
-> Either BLSTError Point1 -> IO Point1
forall a b. (a -> b) -> a -> b
$ ByteString -> Either BLSTError Point1
forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
g1p_raw
    Point1
g1q :: BLS.Point1 <- Either BLSTError Point1 -> IO Point1
forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError (Either BLSTError Point1 -> IO Point1)
-> Either BLSTError Point1 -> IO Point1
forall a b. (a -> b) -> a -> b
$ ByteString -> Either BLSTError Point1
forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
g1q_raw
    Point1
g1add :: BLS.Point1 <- Either BLSTError Point1 -> IO Point1
forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError (Either BLSTError Point1 -> IO Point1)
-> Either BLSTError Point1 -> IO Point1
forall a b. (a -> b) -> a -> b
$ ByteString -> Either BLSTError Point1
forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
g1add_raw
    Point1
g1sub :: BLS.Point1 <- Either BLSTError Point1 -> IO Point1
forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError (Either BLSTError Point1 -> IO Point1)
-> Either BLSTError Point1 -> IO Point1
forall a b. (a -> b) -> a -> b
$ ByteString -> Either BLSTError Point1
forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
g1sub_raw
    Point1
g1mul :: BLS.Point1 <- Either BLSTError Point1 -> IO Point1
forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError (Either BLSTError Point1 -> IO Point1)
-> Either BLSTError Point1 -> IO Point1
forall a b. (a -> b) -> a -> b
$ ByteString -> Either BLSTError Point1
forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
g1mul_raw
    Point1
g1neg :: BLS.Point1 <- Either BLSTError Point1 -> IO Point1
forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError (Either BLSTError Point1 -> IO Point1)
-> Either BLSTError Point1 -> IO Point1
forall a b. (a -> b) -> a -> b
$ ByteString -> Either BLSTError Point1
forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
g1neg_raw
    Point2
g2p :: BLS.Point2 <- Either BLSTError Point2 -> IO Point2
forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError (Either BLSTError Point2 -> IO Point2)
-> Either BLSTError Point2 -> IO Point2
forall a b. (a -> b) -> a -> b
$ ByteString -> Either BLSTError Point2
forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
g2p_raw
    Point2
g2q :: BLS.Point2 <- Either BLSTError Point2 -> IO Point2
forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError (Either BLSTError Point2 -> IO Point2)
-> Either BLSTError Point2 -> IO Point2
forall a b. (a -> b) -> a -> b
$ ByteString -> Either BLSTError Point2
forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
g2q_raw
    Point2
g2add :: BLS.Point2 <- Either BLSTError Point2 -> IO Point2
forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError (Either BLSTError Point2 -> IO Point2)
-> Either BLSTError Point2 -> IO Point2
forall a b. (a -> b) -> a -> b
$ ByteString -> Either BLSTError Point2
forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
g2add_raw
    Point2
g2sub :: BLS.Point2 <- Either BLSTError Point2 -> IO Point2
forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError (Either BLSTError Point2 -> IO Point2)
-> Either BLSTError Point2 -> IO Point2
forall a b. (a -> b) -> a -> b
$ ByteString -> Either BLSTError Point2
forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
g2sub_raw
    Point2
g2mul :: BLS.Point2 <- Either BLSTError Point2 -> IO Point2
forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError (Either BLSTError Point2 -> IO Point2)
-> Either BLSTError Point2 -> IO Point2
forall a b. (a -> b) -> a -> b
$ ByteString -> Either BLSTError Point2
forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
g2mul_raw
    Point2
g2neg :: BLS.Point2 <- Either BLSTError Point2 -> IO Point2
forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError (Either BLSTError Point2 -> IO Point2)
-> Either BLSTError Point2 -> IO Point2
forall a b. (a -> b) -> a -> b
$ ByteString -> Either BLSTError Point2
forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
g2neg_raw

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

    TestName -> Point2 -> Point2 -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual
      TestName
"g2 add"
      Point2
g2add
      (Point2 -> Point2 -> Point2
forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
BLS.blsAddOrDouble Point2
g2p Point2
g2q)
    TestName -> Point2 -> Point2 -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual
      TestName
"g2 sub"
      Point2
g2sub
      (Point2 -> Point2 -> Point2
forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
BLS.blsAddOrDouble Point2
g2p (Point2 -> Point2
forall curve. BLS curve => Point curve -> Point curve
BLS.blsNeg Point2
g2q))
    TestName -> Point2 -> Point2 -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual
      TestName
"g2 mul"
      Point2
g2mul
      (Point2 -> Integer -> Point2
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point2
g2q Integer
scalar)
    TestName -> Point2 -> Point2 -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual
      TestName
"g2 neg"
      Point2
g2neg
      (Point2 -> Point2
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 (Assertion -> TestTree) -> Assertion -> TestTree
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 (TestName -> IO [ByteString]) -> IO TestName -> IO [ByteString]
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"

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

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

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

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

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

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

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

    TestName
-> Either BLSTError Point2 -> Either BLSTError Point2 -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual
      TestName
"g2UncompNotInGroup"
      (BLSTError -> Either BLSTError Point2
forall a b. a -> Either a b
Left BLSTError
BLS.BLST_POINT_NOT_IN_GROUP)
      (ByteString -> Either BLSTError Point2
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 (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
    [ByteString
sig_raw, ByteString
pk_raw] <-
      TestName -> IO [ByteString]
loadHexFile (TestName -> IO [ByteString]) -> IO TestName -> IO [ByteString]
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 = ByteString -> Maybe ByteString -> Maybe ByteString -> Point1
forall curve.
BLS curve =>
ByteString -> Maybe ByteString -> Maybe ByteString -> Point curve
BLS.blsHash (ByteString
aug ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
msg) (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
dst) Maybe ByteString
forall a. Maybe a
Nothing
    Point1
sig <- Either BLSTError Point1 -> IO Point1
forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError (Either BLSTError Point1 -> IO Point1)
-> Either BLSTError Point1 -> IO Point1
forall a b. (a -> b) -> a -> b
$ ByteString -> Either BLSTError Point1
forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
sig_raw
    Point2
pk <- Either BLSTError Point2 -> IO Point2
forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError (Either BLSTError Point2 -> IO Point2)
-> Either BLSTError Point2 -> IO Point2
forall a b. (a -> b) -> a -> b
$ ByteString -> Either BLSTError Point2
forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
pk_raw

    HasCallStack => TestName -> Bool -> Assertion
TestName -> Bool -> Assertion
assertBool TestName
"valid signature" (Bool -> Assertion) -> Bool -> Assertion
forall a b. (a -> b) -> a -> b
$
      PT -> PT -> Bool
BLS.ptFinalVerify
        (Point1 -> Point2 -> PT
BLS.millerLoop Point1
sig Point2
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 (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
    [ByteString
msg_raw, ByteString
large_dst_raw, ByteString
output_raw] <-
      TestName -> IO [ByteString]
loadHexFile (TestName -> IO [ByteString]) -> IO TestName -> IO [ByteString]
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 = Proxy SHA256 -> ByteString -> ByteString
forall h (proxy :: * -> *).
HashAlgorithm h =>
proxy h -> ByteString -> ByteString
forall (proxy :: * -> *). proxy SHA256 -> ByteString -> ByteString
digest (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SHA256) (ByteString
prefix ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
large_dst_raw)
    let hashedMsg :: Point1
hashedMsg = ByteString -> Maybe ByteString -> Maybe ByteString -> Point1
forall curve.
BLS curve =>
ByteString -> Maybe ByteString -> Maybe ByteString -> Point curve
BLS.blsHash ByteString
msg_raw (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
dst_sha) Maybe ByteString
forall a. Maybe a
Nothing
    Point1
expected_output :: BLS.Point1 <- Either BLSTError Point1 -> IO Point1
forall e a. (HasCallStack, Show e) => Either e a -> IO a
eitherShowError (Either BLSTError Point1 -> IO Point1)
-> Either BLSTError Point1 -> IO Point1
forall a b. (a -> b) -> a -> b
$ ByteString -> Either BLSTError Point1
forall curve.
BLS curve =>
ByteString -> Either BLSTError (Point curve)
BLS.blsUncompress ByteString
output_raw

    TestName -> Point1 -> Point1 -> Assertion
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) a -> a -> Property
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 a -> a -> Property
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 = Point curve -> Integer -> Point curve
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point curve
p (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a) Point curve -> Point curve -> Property
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 =
      (Point curve -> Point curve -> Point curve)
-> Point curve -> [Point curve] -> Point curve
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Point curve -> Point curve -> Point curve
forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
BLS.blsAddOrDouble Point curve
forall curve. BLS curve => Point curve
BLS.blsZero ([Point curve] -> Point curve) -> [Point curve] -> Point curve
forall a b. (a -> b) -> a -> b
$ Int -> Point curve -> [Point curve]
forall a. Int -> a -> [a]
replicate (Int -> Int
forall a. Num a => a -> a
abs Int
scalar) (Point curve -> Bool -> Point curve
forall curve. BLS curve => Point curve -> Bool -> Point curve
BLS.blsCneg Point curve
point (Int
scalar Int -> Int -> Bool
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 =
  Point curve -> Bool
forall curve. BLS curve => Point curve -> Bool
BLS.blsIsInf (Point curve -> Point curve -> Point curve
forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
BLS.blsAddOrDouble Point curve
p (Point curve -> Point curve
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 =
  p -> Either err p
forall a b. b -> Either a b
Right p
p Either err p -> Either err p -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (a -> Either err p
decode (a -> Either err p) -> (p -> a) -> p -> Either err p
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 (Point1 -> Integer -> Point1
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 (Point2 -> Integer -> Point2
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point2
q Integer
b)
    t3 :: PT
t3 = Point1 -> Point2 -> PT
BLS.millerLoop (Point1 -> Integer -> Point1
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult Point1
p (Integer
a Integer -> Integer -> Integer
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 (Point1 -> Point1 -> Point1
forall curve.
BLS curve =>
Point curve -> Point curve -> Point curve
BLS.blsAddOrDouble (Point1 -> Point1 -> Point1
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 :: BigInteger -> BigInteger -> BigInteger -> BigInteger -> Property
prop_randomFailsFinalVerify :: BigInteger -> BigInteger -> BigInteger -> BigInteger -> Property
prop_randomFailsFinalVerify (BigInteger Integer
a) (BigInteger Integer
b) (BigInteger Integer
c) (BigInteger Integer
d) =
  (Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
c Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
BLS.scalarPeriod) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= (Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
d Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
BLS.scalarPeriod) Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
    let a' :: Point1
a' = Point1 -> Integer -> Point1
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult (forall curve. BLS curve => Point curve
BLS.blsGenerator @BLS.Curve1) Integer
a
        b' :: Point1
b' = Point1 -> Integer -> Point1
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult (forall curve. BLS curve => Point curve
BLS.blsGenerator @BLS.Curve1) Integer
b
        c' :: Point2
c' = Point2 -> Integer -> Point2
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult (forall curve. BLS curve => Point curve
BLS.blsGenerator @BLS.Curve2) Integer
c
        d' :: Point2
d' = Point2 -> Integer -> Point2
forall curve. BLS curve => Point curve -> Integer -> Point curve
BLS.blsMult (forall curve. BLS curve => Point curve
BLS.blsGenerator @BLS.Curve2) Integer
d
     in PT -> PT -> Bool
BLS.ptFinalVerify (Point1 -> Point2 -> PT
BLS.millerLoop Point1
a' Point2
c') (Point1 -> Point2 -> PT
BLS.millerLoop Point1
b' Point2
d') Bool -> Bool -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Bool
False

newtype BigInteger = BigInteger Integer
  deriving (BigInteger -> BigInteger -> Bool
(BigInteger -> BigInteger -> Bool)
-> (BigInteger -> BigInteger -> Bool) -> Eq BigInteger
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BigInteger -> BigInteger -> Bool
== :: BigInteger -> BigInteger -> Bool
$c/= :: BigInteger -> BigInteger -> Bool
/= :: BigInteger -> BigInteger -> Bool
Eq, Int -> BigInteger -> ShowS
[BigInteger] -> ShowS
BigInteger -> TestName
(Int -> BigInteger -> ShowS)
-> (BigInteger -> TestName)
-> ([BigInteger] -> ShowS)
-> Show BigInteger
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BigInteger -> ShowS
showsPrec :: Int -> BigInteger -> ShowS
$cshow :: BigInteger -> TestName
show :: BigInteger -> TestName
$cshowList :: [BigInteger] -> ShowS
showList :: [BigInteger] -> ShowS
Show)
instance Arbitrary BigInteger where
  arbitrary :: Gen BigInteger
arbitrary = Integer -> BigInteger
BigInteger (Integer -> BigInteger) -> Gen Integer -> Gen BigInteger
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen Integer] -> Gen Integer
forall a. HasCallStack => [Gen a] -> Gen a
oneof [Gen Integer
forall a. Arbitrary a => Gen a
arbitrary, Gen Integer
forall a. Random a => Gen a
chooseAny, (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (-Integer
2 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
128 :: Int), Integer
2 Integer -> Int -> Integer
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 =
    [(Int, Gen (Point curve))] -> Gen (Point curve)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
      [ (Int
1, Point curve -> Gen (Point curve)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Point curve
forall curve. BLS curve => Point curve
BLS.blsZero)
      ,
        ( Int
9
        , do
            [Word8]
str <- Gen [Word8]
forall a. Arbitrary a => Gen a
arbitrary
            let bs :: ByteString
bs = [Word8] -> ByteString
BS.pack [Word8]
str
            Point curve -> Gen (Point curve)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString -> Maybe ByteString -> Point curve
forall curve.
BLS curve =>
ByteString -> Maybe ByteString -> Maybe ByteString -> Point curve
BLS.blsHash ByteString
bs Maybe ByteString
forall a. Maybe a
Nothing Maybe ByteString
forall a. Maybe a
Nothing)
        )
      ]

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

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

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

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

instance Show BLS.Scalar where
  show :: Scalar -> TestName
show = ByteString -> TestName
forall a. Show a => a -> TestName
show (ByteString -> TestName)
-> (Scalar -> ByteString) -> Scalar -> TestName
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 = ByteString -> TestName
forall a. Show a => a -> TestName
show (ByteString -> TestName)
-> (Point curve -> ByteString) -> Point curve -> TestName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point curve -> ByteString
forall curve. BLS curve => Point curve -> ByteString
BLS.blsSerialize

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