pairing 0.5.0 → 1.0.0
raw patch · 42 files changed
+2282/−1399 lines, 42 filesdep +groupsdep +pairingdep −wl-pprint-textdep ~elliptic-curvedep ~galois-fielddep ~protolude
Dependencies added: groups, pairing
Dependencies removed: wl-pprint-text
Dependency ranges changed: elliptic-curve, galois-field, protolude
Files
- ChangeLog.md +21/−7
- README.md +39/−46
- bench/Bench/Hash.hs +35/−0
- bench/Bench/Pairing.hs +53/−0
- bench/Main.hs +12/−0
- benchmarks/HashBenchmarks.hs +0/−17
- benchmarks/Main.hs +0/−12
- benchmarks/PairingBenchmarks.hs +0/−34
- pairing.cabal +47/−56
- src/Data/Pairing.hs +92/−0
- src/Data/Pairing/Ate.hs +182/−0
- src/Data/Pairing/BLS12381.hs +167/−0
- src/Data/Pairing/BN254.hs +160/−0
- src/Data/Pairing/BN254A.hs +177/−0
- src/Data/Pairing/BN254B.hs +134/−0
- src/Data/Pairing/BN254C.hs +134/−0
- src/Data/Pairing/BN254D.hs +134/−0
- src/Data/Pairing/BN462.hs +138/−0
- src/Data/Pairing/Hash.hs +89/−0
- src/Pairing/ByteRepr.hs +0/−127
- src/Pairing/Curve.hs +0/−285
- src/Pairing/Hash.hs +0/−49
- src/Pairing/Pairing.hs +0/−223
- src/Pairing/Serialize/Jivsov.hs +0/−117
- src/Pairing/Serialize/MCLWasm.hs +0/−64
- src/Pairing/Serialize/Types.hs +0/−57
- test/Main.hs +18/−0
- test/Test/BLS12381.hs +68/−0
- test/Test/BN254.hs +68/−0
- test/Test/BN254A.hs +68/−0
- test/Test/BN254B.hs +68/−0
- test/Test/BN254C.hs +68/−0
- test/Test/BN254D.hs +68/−0
- test/Test/BN462.hs +68/−0
- test/Test/Curve.hs +59/−0
- test/Test/Field.hs +73/−0
- test/Test/Pairing.hs +42/−0
- tests/ByteTests.hs +0/−61
- tests/HashTests.hs +0/−22
- tests/Main.hs +0/−14
- tests/PairingTests.hs +0/−147
- tests/SerializeTests.hs +0/−61
ChangeLog.md view
@@ -1,7 +1,21 @@ # Change log for pairing -## 0.5+## 1.0.0 +* Refactor library structure from `Pairing.Pairing` to `Data.Pairing`.+* Rename `reducedPairing` to `pairing` and remove `atePairing`.+* Add major optimisations to `pairing` with detailed documentation.+* Add BN254, BN254A, BN254B, BN254C, BN254D, BN462, BLS12381 curves.+* Add polymorphism of `pairing` for BN curves and BLS12 curves.+* Add polymorphism of `swEncBN` to BN curves.+* Fix dependency issue with `galois-field` and `elliptic-curve`.++## 0.5.1++* Prepend `Math` to modules.++## 0.5.0+ * Use `elliptic-curve` for BN254 elliptic curve group operations. * Refactor Shallue-van de Woestijne encoding for efficiency. * Temporarily remove serialisation.@@ -15,7 +29,7 @@ * Add mclwasm compatible serialisation. * Add efficient storage representation of an elliptic curve point over prime fields. -## 0.4+## 0.4.0 * Use `galois-field` for tower field underlying BN254 curve. @@ -23,13 +37,13 @@ * Use `MonadRandom` typeclass constraints for curve hashing functions. -## 0.3+## 0.3.0 -- Square root calculation on Fq2.-- Both square roots returned on Fq.-- Point serialisation for G1, G2 and GT.+* Square root calculation on Fq2.+* Both square roots returned on Fq.+* Point serialisation for G1, G2 and GT. -## 0.2+## 0.2.0 * Add Shallue-van de Woestijne encoding for curve hashing.
README.md view
@@ -34,39 +34,39 @@ ```haskell import Protolude -import Pairing.Group-import Pairing.Pairing-import Pairing.Point-import Pairing.Fq (Fq(..))-import Pairing.Fq2 (Fq2(..))+import Data.Group (pow)+import Data.Curve.Weierstrass (Point(A), mul') -e1 :: G1-e1 = Point- (Fq 1368015179489954701390400359078579693043519447331113978918064868415326638035)- (Fq 9918110051302171585080402603319702774565515993150576347155970296011118125764)+import Data.Pairing.BN254 (BN254, G1, G2, pairing) +p :: G1 BN254+p = A+ 1368015179489954701390400359078579693043519447331113978918064868415326638035+ 9918110051302171585080402603319702774565515993150576347155970296011118125764 -e2 :: G2-e2 = Point- (Fq2- (Fq 2725019753478801796453339367788033689375851816420509565303521482350756874229)- (Fq 7273165102799931111715871471550377909735733521218303035754523677688038059653)- )- (Fq2- (Fq 2512659008974376214222774206987427162027254181373325676825515531566330959255)- (Fq 957874124722006818841961785324909313781880061366718538693995380805373202866)- ) +q :: G2 BN254+q = A+ [2725019753478801796453339367788033689375851816420509565303521482350756874229+ ,7273165102799931111715871471550377909735733521218303035754523677688038059653+ ]+ [2512659008974376214222774206987427162027254181373325676825515531566330959255+ ,957874124722006818841961785324909313781880061366718538693995380805373202866+ ] main :: IO ()-main = do- putText "Ate pairing:"- print (atePairing e1 e2)- let - lhs = reducedPairing (gMul e1 2) (gMul e2 3)- rhs = (reducedPairing e1 e2)^(2 * 3)- putText "Is bilinear:" - print (lhs == rhs)+main = do+ putText "P:"+ print $ p+ putText "Q:"+ print $ q+ putText "e(P, Q):"+ print $ pairing p q+ putText "e(P, Q) is bilinear:"+ print $ pairing (mul' p a) (mul' q b) == pow (pairing p q) (a * b)+ where+ a = 2 :: Int+ b = 3 :: Int ``` ## Pairings in cryptography@@ -120,27 +120,21 @@ ## Implementation -We have implemented the optimal Ate pairing over the BN128 curve, i.e. we define `q` and `r` as-- * q = 36t<sup>4</sup> + 36t<sup>3</sup> + 24t<sup>2</sup> + 6t + 1- * r = 36t<sup>4</sup> + 36t<sup>3</sup> + 18t<sup>2</sup> + 6t + 1- * t = 4965661367192848881--The tower of finite fields we work with is defined as follows:-- * F<sub>q</sub> is the prime field with characteristic `q`- * F<sub>q<sup>2</sup></sub> := F<sub>q</sub>[u]/u<sup>2</sup> + 1- * F<sub>q<sup>6</sup></sub> := F<sub>q<sup></sub>2</sup>[v]/v<sup>3</sup> - (9 + u)- * F<sub>q<sup>12</sup></sub> := F<sub>q<sup>6</sup></sub>[w]/w<sup>2</sup> - v+We have implemented a polymorphic optimal ate pairing over the following pairing-friendly elliptic curves: -The groups' definitions are:+* Barreto-Lynn-Scott degree 12 curves+ * [BLS12381](src/Data/Pairing/BLS12381.hs)+* Barreto-Naehrig curves+ * [BN254](src/Data/Pairing/BN254.hs)+ * [BN254A](src/Data/Pairing/BN254A.hs)+ * [BN254B](src/Data/Pairing/BN254B.hs)+ * [BN254C](src/Data/Pairing/BN254C.hs)+ * [BN254D](src/Data/Pairing/BN254D.hs)+ * [BN462](src/Data/Pairing/BN462.hs) - * G<sub>1</sub> := E(F<sub>q</sub>), with equation y<sup>2</sup> = x<sup>3</sup> + 3- * G<sub>2</sub> := E'(F<sub>q<sup>2</sup></sub>), with equation y<sup>2</sup> = x<sup>3</sup> + 3 / (9 + u)- * G<sub>T</sub> := μ<sub>r</sub>, i.e. the `r`-th roots of unity subgroup of the multiplicative group of F<sub>q<sup>12</sup></sub>+A more detailed documentation on their domain parameters can be found in our [elliptic curve library](https://github.com/adjoint-io/elliptic-curve). -License--------+## License ``` Copyright (c) 2018-2019 Adjoint Inc.@@ -163,4 +157,3 @@ OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ```-
+ bench/Bench/Hash.hs view
@@ -0,0 +1,35 @@+module Bench.Hash where++import Protolude++import Criterion.Main+import Data.Pairing+import qualified Data.Pairing.BLS12381 as BLS12381+import qualified Data.Pairing.BN254 as BN254+import qualified Data.Pairing.BN254A as BN254A+import qualified Data.Pairing.BN254B as BN254B+import qualified Data.Pairing.BN254C as BN254C+import qualified Data.Pairing.BN254D as BN254D+import qualified Data.Pairing.BN462 as BN462+import Data.Pairing.Hash++benchHash :: Benchmark+benchHash = bgroup "Shallue-van de Woestijne encoding hashing"+ [ bench "BN254" $+ nfIO (swEncBN test_hash :: IO (Maybe (G1 BN254.BN254)))+ , bench "BN254A" $+ nfIO (swEncBN test_hash :: IO (Maybe (G1 BN254A.BN254A)))+ , bench "BN254B" $+ nfIO (swEncBN test_hash :: IO (Maybe (G1 BN254B.BN254B)))+ , bench "BN254C" $+ nfIO (swEncBN test_hash :: IO (Maybe (G1 BN254C.BN254C)))+ , bench "BN254D" $+ nfIO (swEncBN test_hash :: IO (Maybe (G1 BN254D.BN254D)))+ , bench "BN462" $+ nfIO (swEncBN test_hash :: IO (Maybe (G1 BN462.BN462)))+ , bench "BLS12381" $+ nfIO (swEncBN test_hash :: IO (Maybe (G1 BLS12381.BLS12381)))+ ]++test_hash :: ByteString+test_hash = "TyqIPUBYojDVOnDPacfMGrGOzpaQDWD3KZCpqzLhpE4A3kRUCQFUx040Ok139J8WDVV2C99Sfge3G20Q8MEgu23giWmqRxqOc8pH"
+ bench/Bench/Pairing.hs view
@@ -0,0 +1,53 @@+module Bench.Pairing where++import Protolude++import Criterion.Main+import Data.Curve+import Data.Pairing+import qualified Data.Pairing.BLS12381 as BLS12381+import qualified Data.Pairing.BN254 as BN254+import qualified Data.Pairing.BN254A as BN254A+import qualified Data.Pairing.BN254B as BN254B+import qualified Data.Pairing.BN254C as BN254C+import qualified Data.Pairing.BN254D as BN254D+import qualified Data.Pairing.BN462 as BN462++benchPairing :: Benchmark+benchPairing = bgroup "Optimal ate pairing"+ [ bench "BLS12381" $+ nf (uncurry pairing) bls12381+ , bench "BN254" $+ nf (uncurry pairing) bn254+ , bench "BN254A" $+ nf (uncurry pairing) bn254a+ , bench "BN254B" $+ nf (uncurry pairing) bn254b+ , bench "BN254C" $+ nf (uncurry pairing) bn254c+ , bench "BN254D" $+ nf (uncurry pairing) bn254d+ , bench "BN462" $+ nf (uncurry pairing) bn462+ ]++bls12381 :: (G1 BLS12381.BLS12381, G2 BLS12381.BLS12381)+bls12381 = (gen, gen)++bn254 :: (G1 BN254.BN254, G2 BN254.BN254)+bn254 = (gen, gen)++bn254a :: (G1 BN254A.BN254A, G2 BN254A.BN254A)+bn254a = (gen, gen)++bn254b :: (G1 BN254B.BN254B, G2 BN254B.BN254B)+bn254b = (gen, gen)++bn254c :: (G1 BN254C.BN254C, G2 BN254C.BN254C)+bn254c = (gen, gen)++bn254d :: (G1 BN254D.BN254D, G2 BN254D.BN254D)+bn254d = (gen, gen)++bn462 :: (G1 BN462.BN462, G2 BN462.BN462)+bn462 = (gen, gen)
+ bench/Main.hs view
@@ -0,0 +1,12 @@+module Main where++import Protolude++import Criterion.Main++import Bench.Hash+import Bench.Pairing++main :: IO ()+main = defaultMain+ [benchHash, benchPairing]
− benchmarks/HashBenchmarks.hs
@@ -1,17 +0,0 @@-module HashBenchmarks where--import Protolude--import Criterion.Main-import Pairing.Hash--benchmarkHash :: Benchmark-benchmarkHash = bgroup "Hash"- [ bgroup "Hash to G1"- [ bench "swEncBN"- $ whnfIO (swEncBN test_hash)- ]- ]--test_hash :: ByteString-test_hash = "TyqIPUBYojDVOnDPacfMGrGOzpaQDWD3KZCpqzLhpE4A3kRUCQFUx040Ok139J8WDVV2C99Sfge3G20Q8MEgu23giWmqRxqOc8pH"
− benchmarks/Main.hs
@@ -1,12 +0,0 @@-module Main where--import Protolude--import Criterion.Main--import HashBenchmarks-import PairingBenchmarks--main :: IO ()-main = defaultMain- [benchmarkHash, benchmarkPairing]
− benchmarks/PairingBenchmarks.hs
@@ -1,34 +0,0 @@-module PairingBenchmarks where--import Protolude--import Control.Monad.Random-import Criterion.Main-import GaloisField-import Pairing.Curve-import Pairing.Pairing--benchmarkPairing :: Benchmark-benchmarkPairing = bgroup "Pairing"- [ bgroup "Frobenius in Fq12"- [ bench "naive"- $ whnf (frobeniusNaive 1) testFq12- , bench "fast"- $ whnf (fq12Frobenius 1) testFq12- ]- , bgroup "Final exponentiation"- [ bench "naive"- $ whnf finalExponentiationNaive testFq12- , bench "fast"- $ whnf finalExponentiation testFq12- ]- , bgroup "Pairing"- [ bench "without final exponentiation"- $ whnf (uncurry atePairing) (gG1, gG2)- , bench "with final exponentiation"- $ whnf (uncurry reducedPairing) (gG1, gG2)- ]- ]--testFq12 :: Fq12-testFq12 = evalRand rnd (mkStdGen 0)
pairing.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 989fbbc05f694224014af023e74794a8b42a03f96549681b5404623aee4ec01c+-- hash: 4557c34ff1d521a4f852373a67aecb963ea5357ddecdf3dcaaf0bc28bb58897f name: pairing-version: 0.5.0+version: 1.0.0 synopsis: Bilinear pairings description: Optimal Ate pairing over Barreto-Naehrig curves category: Cryptography@@ -27,100 +27,91 @@ library exposed-modules:- Pairing.ByteRepr- Pairing.Curve- Pairing.Hash- Pairing.Pairing- Pairing.Serialize.Types- Pairing.Serialize.Jivsov- Pairing.Serialize.MCLWasm+ Data.Pairing+ Data.Pairing.Ate+ Data.Pairing.BLS12381+ Data.Pairing.BN254+ Data.Pairing.BN254A+ Data.Pairing.BN254B+ Data.Pairing.BN254C+ Data.Pairing.BN254D+ Data.Pairing.BN462+ Data.Pairing.Hash other-modules: Paths_pairing hs-source-dirs: src- default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances FlexibleContexts ScopedTypeVariables RankNTypes BangPatterns DataKinds DeriveAnyClass DeriveFunctor DeriveGeneric GeneralizedNewtypeDeriving MultiParamTypeClasses PatternSynonyms TypeApplications TypeSynonymInstances- ghc-options: -freverse-errors -Wall+ default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances FlexibleContexts ScopedTypeVariables RankNTypes ConstraintKinds DataKinds DeriveGeneric GeneralizedNewtypeDeriving MultiParamTypeClasses OverloadedLists PatternSynonyms TypeFamilyDependencies+ ghc-options: -freverse-errors -O2 -Wall build-depends: MonadRandom- , QuickCheck , base >=4.10 && <5 , bytestring- , elliptic-curve >=0.2 && <0.3+ , elliptic-curve >=0.3 && <0.4 , errors- , galois-field >=0.4 && <0.5- , protolude >=0.2- , wl-pprint-text+ , galois-field >=1 && <2+ , groups+ , protolude >=0.2 && <0.3+ , tasty-quickcheck default-language: Haskell2010 test-suite pairing-tests type: exitcode-stdio-1.0 main-is: Main.hs other-modules:- Pairing.ByteRepr- Pairing.Curve- Pairing.Hash- Pairing.Pairing- Pairing.Serialize.Jivsov- Pairing.Serialize.MCLWasm- Pairing.Serialize.Types- ByteTests- HashTests- PairingTests- SerializeTests+ Test.BLS12381+ Test.BN254+ Test.BN254A+ Test.BN254B+ Test.BN254C+ Test.BN254D+ Test.BN462+ Test.Curve+ Test.Field+ Test.Pairing Paths_pairing hs-source-dirs:- src- tests- default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances FlexibleContexts ScopedTypeVariables RankNTypes BangPatterns DataKinds DeriveAnyClass DeriveFunctor DeriveGeneric GeneralizedNewtypeDeriving MultiParamTypeClasses PatternSynonyms TypeApplications TypeSynonymInstances- ghc-options: -freverse-errors -Wall -main-is Main+ test+ default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances FlexibleContexts ScopedTypeVariables RankNTypes ConstraintKinds DataKinds DeriveGeneric GeneralizedNewtypeDeriving MultiParamTypeClasses OverloadedLists PatternSynonyms TypeFamilyDependencies+ ghc-options: -freverse-errors -O2 -Wall -main-is Main build-depends: MonadRandom , QuickCheck , base >=4.10 && <5 , bytestring- , elliptic-curve >=0.2 && <0.3+ , elliptic-curve >=0.3 && <0.4 , errors- , galois-field >=0.4 && <0.5- , protolude >=0.2+ , galois-field >=1 && <2+ , groups+ , pairing+ , protolude >=0.2 && <0.3 , quickcheck-instances , tasty , tasty-hunit , tasty-quickcheck- , wl-pprint-text default-language: Haskell2010 benchmark pairing-benchmarks type: exitcode-stdio-1.0 main-is: Main.hs other-modules:- Pairing.ByteRepr- Pairing.Curve- Pairing.Hash- Pairing.Pairing- Pairing.Serialize.Jivsov- Pairing.Serialize.MCLWasm- Pairing.Serialize.Types- HashBenchmarks- PairingBenchmarks+ Bench.Hash+ Bench.Pairing Paths_pairing hs-source-dirs:- src- benchmarks- default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances FlexibleContexts ScopedTypeVariables RankNTypes BangPatterns DataKinds DeriveAnyClass DeriveFunctor DeriveGeneric GeneralizedNewtypeDeriving MultiParamTypeClasses PatternSynonyms TypeApplications TypeSynonymInstances- ghc-options: -freverse-errors -Wall -main-is Main+ bench+ default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances FlexibleContexts ScopedTypeVariables RankNTypes ConstraintKinds DataKinds DeriveGeneric GeneralizedNewtypeDeriving MultiParamTypeClasses OverloadedLists PatternSynonyms TypeFamilyDependencies+ ghc-options: -freverse-errors -O2 -Wall -main-is Main build-depends: MonadRandom- , QuickCheck , base >=4.10 && <5 , bytestring , criterion- , elliptic-curve >=0.2 && <0.3+ , elliptic-curve >=0.3 && <0.4 , errors- , galois-field >=0.4 && <0.5- , protolude >=0.2- , quickcheck-instances- , tasty- , tasty-hunit+ , galois-field >=1 && <2+ , groups+ , pairing+ , protolude >=0.2 && <0.3 , tasty-quickcheck- , wl-pprint-text default-language: Haskell2010
+ src/Data/Pairing.hs view
@@ -0,0 +1,92 @@+module Data.Pairing+ (+ -- * Pairings+ Pairing(..)+ -- ** Pairing-friendly elliptic curves+ , ECPairing+ , ECPairingG1+ , ECPairingG2+ , ECPairingGT+ ) where++import Protolude++import Control.Monad.Random (Random)+import Data.Curve.Weierstrass (WACurve, WAPoint)+import Data.Group (Group)+import Data.Field.Galois (Extension, IrreducibleMonic, Prime, RootsOfUnity)+import Test.Tasty.QuickCheck (Arbitrary)++-------------------------------------------------------------------------------+-- Pairings+-------------------------------------------------------------------------------++-- | Pairings of general cryptographic groups.+--+-- Let @G1@ and @G2@ be additive cyclic groups of prime order @r@,+-- and @GT@ be a multiplicative cyclic group of prime order @r@.+--+-- Then the pairing is defined to be of type @G1 x G2 -> GT@,+-- and satisfies bilinearity, non-degeneracy, and computability.+class (Arbitrary (G1 e), Arbitrary (G2 e), Arbitrary (GT e),+ Eq (G1 e), Eq (G2 e), Eq (GT e),+ Generic (G1 e), Generic (G2 e), Generic (GT e),+ Group (G1 e), Group (G2 e), Group (GT e),+ NFData (G1 e), NFData (G2 e), NFData (GT e),+ Random (G1 e), Random (G2 e), Random (GT e),+ Show (G1 e), Show (G2 e), Show (GT e)) => Pairing e where+ {-# MINIMAL pairing #-}++ -- | Left group @G1@.+ type family G1 e = (g :: *) | g -> e++ -- | Right group @G2@.+ type family G2 e = (g :: *) | g -> e++ -- | Target group @GT@.+ type family GT e = (g :: *) | g -> e++ -- | Computable non-degenerate bilinear map.+ pairing :: G1 e -> G2 e -> GT e++-------------------------------------------------------------------------------+-- Pairing-friendly elliptic curves+-------------------------------------------------------------------------------++-- | Pairings of a family of pairing-friendly elliptic curves.+--+-- Let @E(Fq)@ be an elliptic curve over a prime field @Fq@,+-- and let @Fq < Fq' < Fq'' < Fq'''@ be a tower of simple field extensions+-- defined by irreducible monic polynomials @u@, @v@, and @w@.+--+-- Then the pairing is defined to be of type @E(Fq) x E(Fq') -> U_r@,+-- where @U_r@ is the @r@-th roots of unity multiplicative subgroup of @Fq'''@,+-- and @r@ is the order of @E(Fq)@ and the order of a prime field @Fr@.+type ECPairing e q r u v w =+ ( Pairing e+ , ECPairingG1 e q r+ , ECPairingG2 e q r u+ , ECPairingGT e q r u v w+ )++-- | Pairing-friendly elliptic curve left group @E(Fq)@.+type ECPairingG1 e q r =+ ( KnownNat q+ , WACurve e (Prime q) (Prime r)+ , G1 e ~ WAPoint e (Prime q) (Prime r)+ )++-- | Pairing-friendly elliptic curve right group @E(Fq')@.+type ECPairingG2 e q r u =+ ( IrreducibleMonic u (Prime q)+ , WACurve e (Extension u (Prime q)) (Prime r)+ , G2 e ~ WAPoint e (Extension u (Prime q)) (Prime r)+ )++-- | Pairing-friendly field multiplicative target group @U_r@.+type ECPairingGT e q r u v w =+ ( KnownNat r+ , IrreducibleMonic v (Extension u (Prime q))+ , IrreducibleMonic w (Extension v (Extension u (Prime q)))+ , GT e ~ RootsOfUnity r (Extension w (Extension v (Extension u (Prime q))))+ )
+ src/Data/Pairing/Ate.hs view
@@ -0,0 +1,182 @@+module Data.Pairing.Ate+ ( module Data.Pairing+ -- * Optimal ate pairing of BLS curves+ , millerAlgorithmBLS12+ , finalExponentiationBLS12+ -- * Optimal ate pairing of BN curves+ , millerAlgorithmBN+ , finalExponentiationBN+ ) where++import Protolude++import Data.Curve.Weierstrass (Curve(..), Point(..))+import Data.Field.Galois as F hiding (recip, (/))++import Data.Pairing++-------------------------------------------------------------------------------+-- Miller algorithm+-------------------------------------------------------------------------------++-- | [Miller algorithm for Barreto-Lynn-Scott degree 12 curves]+-- (https://eprint.iacr.org/2016/130.pdf).+millerAlgorithmBLS12 :: ECPairing e q r u v w+ => [Int8] -> G1 e -> G2 e -> GT e+millerAlgorithmBLS12 (x:xs) p q = snd $+ millerLoop p q xs (if x > 0 then q else inv q, mempty)+millerAlgorithmBLS12 _ _ _ = mempty+{-# INLINABLE millerAlgorithmBLS12 #-}++-- | [Miller algorithm for Barreto-Naehrig curves]+-- (https://eprint.iacr.org/2010/354.pdf).+millerAlgorithmBN :: ECPairing e q r u v w+ => Extension u (Prime q) -> [Int8] -> G1 e -> G2 e -> GT e+millerAlgorithmBN xi (x:xs) p q = finalStepBN xi p q $+ millerLoop p q xs (if x > 0 then q else inv q, mempty)+millerAlgorithmBN _ _ _ _ = mempty+{-# INLINABLE millerAlgorithmBN #-}++-- Miller loop, line 2 to line 10.+millerLoop :: ECPairing e q r u v w+ => G1 e -> G2 e -> [Int8] -> (G2 e, GT e) -> (G2 e, GT e)+millerLoop p q = millerLoop'+ where+ millerLoop' [] tf = tf+ millerLoop' (x:xs) tf = case doublingStep p tf of+ tf2+ | x == 0 -> millerLoop' xs tf2+ | x == 1 -> millerLoop' xs $ additionStep p q tf2+ | otherwise -> millerLoop' xs $ additionStep p (inv q) tf2+{-# INLINABLE millerLoop #-}++-- Doubling step, line 4.+doublingStep :: ECPairing e q r u v w+ => G1 e -> (G2 e, GT e) -> (G2 e, GT e)+doublingStep p (t, f) = (<>) f . (<>) f <$> lineFunction p t t+{-# INLINABLE doublingStep #-}++-- Addition step, line 6 and line 8.+additionStep :: ECPairing e q r u v w+ => G1 e -> G2 e -> (G2 e, GT e) -> (G2 e, GT e)+additionStep p q (t, f) = (<>) f <$> lineFunction p q t+{-# INLINABLE additionStep #-}++-- Final step for BN curves, line 11 to line 13.+finalStepBN :: ECPairing e q r u v w+ => Extension u (Prime q) -> G1 e -> G2 e -> (G2 e, GT e) -> GT e+finalStepBN xi p q (t, f) = case lineFunction p t q1 of+ (t', f') -> case lineFunction p t' q2 of+ (_, f'') -> f <> f' <> f''+ where+ q1 = frobTwisted xi q+ q2 = inv $ frobTwisted xi q1+{-# INLINABLE finalStepBN #-}++-------------------------------------------------------------------------------+-- Final exponentiation+-------------------------------------------------------------------------------++-- | [Final exponentiation for Barreto-Lynn-Scott degree 12 curves]+-- (https://eprint.iacr.org/2016/130.pdf).+finalExponentiationBLS12 :: ECPairing e q r u v w+ => Integer -> GT e -> GT e+finalExponentiationBLS12 u = (<$>) $ hardPart . easyPart+ where+ easyPart = p2 . p6+ where+ p6 = (*) <$> conj <*> recip -- f^(p^6 - 1)+ p2 = (*) <$> identity <*> F.frob . F.frob -- f^(p^2 + 1)+ hardPart f = p4+ where+ f2 = f * f -- f^2+ y3 = powUnitary (powUnitary f u * conj f2) u * f -- f^(lambda_3)+ y2 = powUnitary y3 u -- f^(lambda_2)+ y1 = powUnitary y2 u * conj y3 -- f^(lambda_1)+ y0 = powUnitary y1 u * f2 * f -- f^(lambda_0)+ p4 = y0 * F.frob (y1 * F.frob (y2 * (F.frob y3))) -- f^((p^4 - p^2 + 1) / r)+{-# INLINABLE finalExponentiationBLS12 #-}++-- | [Final exponentiation for Barreto-Naehrig curves]+-- (https://eprint.iacr.org/2010/354.pdf).+finalExponentiationBN :: ECPairing e q r u v w+ => Integer -> GT e -> GT e+finalExponentiationBN u = (<$>) $ hardPart . easyPart+ where+ easyPart = p2 . p6+ where+ p6 = (*) <$> conj <*> recip -- f^(p^6 - 1)+ p2 = (*) <$> identity <*> F.frob . F.frob -- f^(p^2 + 1)+ hardPart f = p4+ where+ fu = powUnitary f u -- f^u+ fu2 = powUnitary fu u -- f^(u^2)+ fu3 = powUnitary fu2 u -- f^(u^3)+ fpu = F.frob fu2 -- f^(pu^2)+ y0 = F.frob (f * F.frob (f * F.frob f)) -- f^(p + p^2 + p^3)+ y1 = conj f -- f^(-1)+ y2 = F.frob fpu -- f^(p^2u^2)+ y3 = conj $ F.frob fu -- f^(-pu)+ y4 = conj $ fu * fpu -- f^(-u - pu^2)+ y5 = conj fu2 -- f^(-u^2)+ y6 = conj $ fu3 * F.frob fu3 -- f^(-u^3 - pu^3)+ p4 = p4' * y0 * join (*) (p4' * y1) -- f^((p^4 - p^2 + 1) / r)+ where+ p4' = join (*) $ p4'' * y2 * join (*) (p4'' * y3 * y5)+ p4'' = y4 * y5 * join (*) y6+{-# INLINABLE finalExponentiationBN #-}++-------------------------------------------------------------------------------+-- Auxiliary functions+-------------------------------------------------------------------------------++-- | Line function evaluation @Line(T, Q, P)@.+--+-- Compute the line function between two points @T@ and @Q@ in @G2@,+-- evaluate the line function at a point @P@ in @G1@,+-- and embed the line function evaluation in @GT@.+lineFunction :: ECPairing e q r u v w+ => G1 e -- ^ Point @P@.+ -> G2 e -- ^ Point @T@.+ -> G2 e -- ^ Point @Q@.+ -> (G2 e, GT e) -- ^ Points @T + Q@ and @Line(T, Q, P)@.+lineFunction (A x y) (A x1 y1) (A x2 y2)+ | x1 /= x2 = (A x3 y3 , toU' [embed $ -y, [x *^ l , y1 - l * x1]])+ | y1 + y2 == 0 = (O , toU' [embed x, embed $ -x1 ])+ | otherwise = (A x3' y3', toU' [embed $ -y, [x *^ l', y1 - l' * x1]])+ where+ l = (y2 - y1) / (x2 - x1)+ x3 = l * l - x1 - x2+ y3 = l * (x1 - x3) - y1+ x12 = x1 * x1+ l' = (x12 + x12 + x12) / (y1 + y1)+ x3' = l' * l' - x1 - x2+ y3' = l' * (x1 - x3') - y1+lineFunction _ _ _ = (O, mempty)+{-# INLINABLE lineFunction #-}++-- | Twisted Frobenius endomorphism @Frob(P)@.+--+-- Compute the Frobenius endomorphism on a point @P@ given a twist @xi@.+frobTwisted :: forall e q r u v w . ECPairing e q r u v w+ => Extension u (Prime q) -- ^ Twist @xi@.+ -> G2 e -- ^ Point @P@.+ -> G2 e -- ^ Point @Frob(P)@.+frobTwisted xi (A x y) = A (F.frob x * pow xi tx) (F.frob y * pow xi ty)+ where+ tx = quot (F.char (witness :: Prime q) - 1) 3+ ty = shiftR (F.char (witness :: Prime q)) 1+frobTwisted _ _ = O++-- | Unitary exponentiation @^@.+--+-- Exponentiation of a unitary element @x@ to an arbitrary integer @n@+-- in a specified cyclotomic subgroup.+powUnitary :: IrreducibleMonic p k+ => Extension p k -- ^ Element @x@ in cyclotomic subgroup.+ -> Integer -- ^ Integer @n@.+ -> Extension p k -- ^ Element @x ^ n@.+powUnitary x n+ | n < 0 = pow (conj x) (negate n)+ | otherwise = pow x n+{-# INLINE powUnitary #-}
+ src/Data/Pairing/BLS12381.hs view
@@ -0,0 +1,167 @@+{-# OPTIONS -fno-warn-orphans #-}++module Data.Pairing.BLS12381+ ( module Data.Pairing+ , module Data.Pairing.Ate+ -- * BLS12381 curve+ , BLS12381+ , parameterBin+ , parameterHex+ -- ** Fields+ , Fq+ , Fq2+ , Fq6+ , Fq12+ , Fr+ -- ** Groups+ , G1'+ , G2'+ , GT'+ -- ** Roots of unity+ , getRootOfUnity+ ) where++import Protolude++import Data.Curve.Weierstrass.BLS12381 as G1+import Data.Curve.Weierstrass.BLS12381T as G2+import Data.Field.Galois as F++import Data.Pairing+import Data.Pairing.Ate++-------------------------------------------------------------------------------+-- Fields+-------------------------------------------------------------------------------++-- Cubic nonresidue in @Fq2@.+xi :: Fq2+xi =+ [ 0xd0088f51cbff34d258dd3db21a5d66bb23ba5c279c2895fb39869507b587b120f55ffff58a9ffffdcff7fffffffd556+ , 0xd0088f51cbff34d258dd3db21a5d66bb23ba5c279c2895fb39869507b587b120f55ffff58a9ffffdcff7fffffffd555+ ]+{-# INLINABLE xi #-}++-- | Field of points of BLS12381 curve over @Fq6@.+type Fq6 = Extension V Fq2+data V+instance IrreducibleMonic V Fq2 where+ poly _ = [-xi, 0, 0, 1]+ {-# INLINABLE poly #-}++-- | Field of points of BLS12381 curve over @Fq12@.+type Fq12 = Extension W Fq6+data W+instance IrreducibleMonic W Fq6 where+ poly _ = [[0, -1], 0, 1]+ {-# INLINABLE poly #-}++-------------------------------------------------------------------------------+-- Curves+-------------------------------------------------------------------------------++-- | BLS12381 curve left group @G1 = E(Fq)@.+type G1' = G1.PA++-- | BLS12381 curve right group @G2 = E'(Fq2)@.+type G2' = G2.PA++-- | @Fq12@ multiplicative target group @GT@.+type GT' = RootsOfUnity R Fq12+instance CyclicSubgroup (RootsOfUnity R Fq12) where+ gen = toU'+ [ [ [ 0x1250ebd871fc0a92a7b2d83168d0d727272d441befa15c503dd8e90ce98db3e7b6d194f60839c508a84305aaca1789b6+ , 0x89a1c5b46e5110b86750ec6a532348868a84045483c92b7af5af689452eafabf1a8943e50439f1d59882a98eaa0170f+ ]+ , [ 0x31ee0cf8176faed3d5e214d37e4837b518958ee5c39b2997f01e9ffb9e533bf5cb7335184e4b9b91c232bd7551f5ef+ , 0x333fc379662be784e4ed53bc809b8c242cd5c26049b5dbe98b3e9599912e2523dbb28ca5f0764eaa9980581f5dd5f5b+ ]+ , [ 0x1434ca7627208b631fab9fe851983efa300f78c547c61f10017a080635adb658fcc639b4ed513fdb10cb2a9862a855e3+ , 0x129cac1291d7cede0e5c448a7fa1879dd6e1d4579d8748542c3a143f14588050bf3874ac39dc273dff6d6e70dadc272b+ ]+ ]+ , [ [ 0xf84ad8722c9486446b9d04ee5c12b31ca548f26fc85317fa4ae45dcacca2709ef1851df07d1c7ac4d23a6ebf1a82869+ , 0x140766a9b0c7736808ab0e3042aa7be8dd368d5062528949fb7c4413b0f51b6d7989a629b646c3ea8eed395c68774a20+ ]+ , [ 0xe83a4cf2599c26539d4183cce2597a90179aa3ac63883345c450f5245902578fd4737c27d92fcef5d7122d2718820b5+ , 0x14edc37a74f7bc0cc00ab7d3a7f085e28ebb7d2b9ba3b19a9dd51cacb1a07799f497594dbed2f8a2d9b64613f63d53f9+ ]+ , [ 0x12f6c0f91a404c38fd5629091c63e94df3020950c1adc74636d2cca650f75efe9f15ba1a87a57f85ff69a0640ea93d83+ , 0x6ecf38c504bc3b9f13ba96c27fbaa763995b521b26e8bb21f46fb401dc62936b863f0edd45760f665c063e9ba54e90c+ ]+ ]+ ]+ {-# INLINABLE gen #-}++-------------------------------------------------------------------------------+-- Pairings+-------------------------------------------------------------------------------++-- | BLS12381 curve parameter @s = t@ in signed binary.+parameterBin :: [Int8]+parameterBin = [-1,-1, 0,-1, 0, 0,-1, 0, 0, 0, 0, 0, 0, 0, 0,-1, 0+ , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0+ , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-1, 0+ , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0+ ]+{-# INLINABLE parameterBin #-}++-- | BLS12381 curve parameter @t@ in hexadecimal.+parameterHex :: Integer+parameterHex = -0xd201000000010000+{-# INLINABLE parameterHex #-}++-- BLS12381 curve is pairing-friendly.+instance Pairing BLS12381 where++ type instance G1 BLS12381 = G1'++ type instance G2 BLS12381 = G2'++ type instance GT BLS12381 = GT'++ pairing = (.) (finalExponentiationBLS12 parameterHex)+ . millerAlgorithmBLS12 parameterBin+ {-# INLINABLE pairing #-}++-------------------------------------------------------------------------------+-- Roots of unity+-------------------------------------------------------------------------------++-- | Precompute primitive roots of unity for binary powers that divide @r - 1@.+getRootOfUnity :: Int -> Fr+getRootOfUnity 0 = 1+getRootOfUnity 1 = 52435875175126190479447740508185965837690552500527637822603658699938581184512+getRootOfUnity 2 = 3465144826073652318776269530687742778270252468765361963008+getRootOfUnity 3 = 28761180743467419819834788392525162889723178799021384024940474588120723734663+getRootOfUnity 4 = 35811073542294463015946892559272836998938171743018714161809767624935956676211+getRootOfUnity 5 = 32311457133713125762627935188100354218453688428796477340173861531654182464166+getRootOfUnity 6 = 6460039226971164073848821215333189185736442942708452192605981749202491651199+getRootOfUnity 7 = 3535074550574477753284711575859241084625659976293648650204577841347885064712+getRootOfUnity 8 = 21071158244812412064791010377580296085971058123779034548857891862303448703672+getRootOfUnity 9 = 12531186154666751577774347439625638674013361494693625348921624593362229945844+getRootOfUnity 10 = 21328829733576761151404230261968752855781179864716879432436835449516750606329+getRootOfUnity 11 = 30450688096165933124094588052280452792793350252342406284806180166247113753719+getRootOfUnity 12 = 7712148129911606624315688729500842900222944762233088101895611600385646063109+getRootOfUnity 13 = 4862464726302065505506688039068558711848980475932963135959468859464391638674+getRootOfUnity 14 = 36362449573598723777784795308133589731870287401357111047147227126550012376068+getRootOfUnity 15 = 30195699792882346185164345110260439085017223719129789169349923251189180189908+getRootOfUnity 16 = 46605497109352149548364111935960392432509601054990529243781317021485154656122+getRootOfUnity 17 = 2655041105015028463885489289298747241391034429256407017976816639065944350782+getRootOfUnity 18 = 42951892408294048319804799042074961265671975460177021439280319919049700054024+getRootOfUnity 19 = 26418991338149459552592774439099778547711964145195139895155358980955972635668+getRootOfUnity 20 = 23615957371642610195417524132420957372617874794160903688435201581369949179370+getRootOfUnity 21 = 50175287592170768174834711592572954584642344504509533259061679462536255873767+getRootOfUnity 22 = 1664636601308506509114953536181560970565082534259883289958489163769791010513+getRootOfUnity 23 = 36760611456605667464829527713580332378026420759024973496498144810075444759800+getRootOfUnity 24 = 13205172441828670567663721566567600707419662718089030114959677511969243860524+getRootOfUnity 25 = 10335750295308996628517187959952958185340736185617535179904464397821611796715+getRootOfUnity 26 = 51191008403851428225654722580004101559877486754971092640244441973868858562750+getRootOfUnity 27 = 24000695595003793337811426892222725080715952703482855734008731462871475089715+getRootOfUnity 28 = 18727201054581607001749469507512963489976863652151448843860599973148080906836+getRootOfUnity 29 = 50819341139666003587274541409207395600071402220052213520254526953892511091577+getRootOfUnity 30 = 3811138593988695298394477416060533432572377403639180677141944665584601642504+getRootOfUnity 31 = 43599901455287962219281063402626541872197057165786841304067502694013639882090+getRootOfUnity 32 = 937917089079007706106976984802249742464848817460758522850752807661925904159+getRootOfUnity _ = panic "getRootOfUnity: exponent too big for Fr / negative"+{-# INLINABLE getRootOfUnity #-}
+ src/Data/Pairing/BN254.hs view
@@ -0,0 +1,160 @@+{-# OPTIONS -fno-warn-orphans #-}++module Data.Pairing.BN254+ ( module Data.Pairing+ , module Data.Pairing.Ate+ -- * BN254 curve+ , BN254+ , parameterBin+ , parameterHex+ -- ** Fields+ , Fq+ , Fq2+ , Fq6+ , Fq12+ , Fr+ -- ** Groups+ , G1'+ , G2'+ , GT'+ -- ** Roots of unity+ , getRootOfUnity+ ) where++import Protolude++import Data.Curve.Weierstrass.BN254 as G1+import Data.Curve.Weierstrass.BN254T as G2+import Data.Field.Galois as F++import Data.Pairing+import Data.Pairing.Ate++-------------------------------------------------------------------------------+-- Fields+-------------------------------------------------------------------------------++-- Cubic nonresidue in @Fq2@.+xi :: Fq2+xi = [9, 1]+{-# INLINABLE xi #-}++-- | Field of points of BN254 curve over @Fq6@.+type Fq6 = Extension V Fq2+data V+instance IrreducibleMonic V Fq2 where+ poly _ = [-xi, 0, 0, 1]+ {-# INLINABLE poly #-}++-- | Field of points of BN254 curve over @Fq12@.+type Fq12 = Extension W Fq6+data W+instance IrreducibleMonic W Fq6 where+ poly _ = [[0, -1], 0, 1]+ {-# INLINABLE poly #-}++-------------------------------------------------------------------------------+-- Curves+-------------------------------------------------------------------------------++-- | BN254 curve left group @G1 = E(Fq)@.+type G1' = G1.PA++-- | BN254 curve right group @G2 = E'(Fq2)@.+type G2' = G2.PA++-- | @Fq12@ multiplicative target group @GT@.+type GT' = RootsOfUnity R Fq12+instance CyclicSubgroup (RootsOfUnity R Fq12) where+ gen = toU'+ [ [ [ 0x12c70e90e12b7874510cd1707e8856f71bf7f61d72631e268fca81000db9a1f5+ , 0x84f330485b09e866bc2f2ea2b897394deaf3f12aa31f28cb0552990967d4704+ ]+ , [ 0xe841c2ac18a4003ac9326b9558380e0bc27fdd375e3605f96b819a358d34bde+ , 0x2067586885c3318eeffa1938c754fe3c60224ee5ae15e66af6b5104c47c8c5d8+ ]+ , [ 0x1676555de427abc409c4a394bc5426886302996919d4bf4bdd02236e14b3636+ , 0x2b03614464f04dd772d86df88674c270ffc8747ea13e72da95e3594468f222c4+ ]+ ]+ , [ [ 0x2c53748bcd21a7c038fb30ddc8ac3bf0af25d7859cfbc12c30c866276c565909+ , 0x27ed208e7a0b55ae6e710bbfbd2fd922669c026360e37cc5b2ab862411536104+ ]+ , [ 0x1ad9db1937fd72f4ac462173d31d3d6117411fa48dba8d499d762b47edb3b54a+ , 0x279db296f9d479292532c7c493d8e0722b6efae42158387564889c79fc038ee3+ ]+ , [ 0xdc26f240656bbe2029bd441d77c221f0ba4c70c94b29b5f17f0f6d08745a069+ , 0x108c19d15f9446f744d0f110405d3856d6cc3bda6c4d537663729f5257628417+ ]+ ]+ ]+ {-# INLINABLE gen #-}++-------------------------------------------------------------------------------+-- Pairings+-------------------------------------------------------------------------------++-- | BN254 curve parameter @s = 6t + 2@ in signed binary.+parameterBin :: [Int8]+parameterBin = [ 1, 1, 0, 1, 0, 0,-1, 0, 1, 1, 0, 0, 0,-1, 0, 0, 1+ , 1, 0, 0,-1, 0, 0, 0, 0, 0, 1, 0, 0,-1, 0, 0, 1+ , 1, 1, 0, 0, 0, 0,-1, 0, 1, 0, 0,-1, 0, 1, 1, 0+ , 0, 1, 0, 0,-1, 1, 0, 0,-1, 0, 1, 0, 1, 0, 0, 0+ ]+{-# INLINABLE parameterBin #-}++-- | BN254 curve parameter @t@ in hexadecimal.+parameterHex :: Integer+parameterHex = 0x44e992b44a6909f1+{-# INLINABLE parameterHex #-}++-- BN254 curve is pairing-friendly.+instance Pairing BN254 where++ type instance G1 BN254 = G1'++ type instance G2 BN254 = G2'++ type instance GT BN254 = GT'++ pairing = (.) (finalExponentiationBN parameterHex)+ . millerAlgorithmBN xi parameterBin+ {-# INLINABLE pairing #-}++-------------------------------------------------------------------------------+-- Roots of unity+-------------------------------------------------------------------------------++-- | Precompute primitive roots of unity for binary powers that divide @r - 1@.+getRootOfUnity :: Int -> Fr+getRootOfUnity 0 = 1+getRootOfUnity 1 = 21888242871839275222246405745257275088548364400416034343698204186575808495616+getRootOfUnity 2 = 21888242871839275217838484774961031246007050428528088939761107053157389710902+getRootOfUnity 3 = 19540430494807482326159819597004422086093766032135589407132600596362845576832+getRootOfUnity 4 = 14940766826517323942636479241147756311199852622225275649687664389641784935947+getRootOfUnity 5 = 4419234939496763621076330863786513495701855246241724391626358375488475697872+getRootOfUnity 6 = 9088801421649573101014283686030284801466796108869023335878462724291607593530+getRootOfUnity 7 = 10359452186428527605436343203440067497552205259388878191021578220384701716497+getRootOfUnity 8 = 3478517300119284901893091970156912948790432420133812234316178878452092729974+getRootOfUnity 9 = 6837567842312086091520287814181175430087169027974246751610506942214842701774+getRootOfUnity 10 = 3161067157621608152362653341354432744960400845131437947728257924963983317266+getRootOfUnity 11 = 1120550406532664055539694724667294622065367841900378087843176726913374367458+getRootOfUnity 12 = 4158865282786404163413953114870269622875596290766033564087307867933865333818+getRootOfUnity 13 = 197302210312744933010843010704445784068657690384188106020011018676818793232+getRootOfUnity 14 = 20619701001583904760601357484951574588621083236087856586626117568842480512645+getRootOfUnity 15 = 20402931748843538985151001264530049874871572933694634836567070693966133783803+getRootOfUnity 16 = 421743594562400382753388642386256516545992082196004333756405989743524594615+getRootOfUnity 17 = 12650941915662020058015862023665998998969191525479888727406889100124684769509+getRootOfUnity 18 = 11699596668367776675346610687704220591435078791727316319397053191800576917728+getRootOfUnity 19 = 15549849457946371566896172786938980432421851627449396898353380550861104573629+getRootOfUnity 20 = 17220337697351015657950521176323262483320249231368149235373741788599650842711+getRootOfUnity 21 = 13536764371732269273912573961853310557438878140379554347802702086337840854307+getRootOfUnity 22 = 12143866164239048021030917283424216263377309185099704096317235600302831912062+getRootOfUnity 23 = 934650972362265999028062457054462628285482693704334323590406443310927365533+getRootOfUnity 24 = 5709868443893258075976348696661355716898495876243883251619397131511003808859+getRootOfUnity 25 = 19200870435978225707111062059747084165650991997241425080699860725083300967194+getRootOfUnity 26 = 7419588552507395652481651088034484897579724952953562618697845598160172257810+getRootOfUnity 27 = 2082940218526944230311718225077035922214683169814847712455127909555749686340+getRootOfUnity 28 = 19103219067921713944291392827692070036145651957329286315305642004821462161904+getRootOfUnity _ = panic "getRootOfUnity: exponent too big for Fr / negative"+{-# INLINABLE getRootOfUnity #-}
+ src/Data/Pairing/BN254A.hs view
@@ -0,0 +1,177 @@+{-# OPTIONS -fno-warn-orphans #-}++module Data.Pairing.BN254A+ ( module Data.Pairing+ , module Data.Pairing.Ate+ -- * BN254A curve+ , BN254A+ , parameterBin+ , parameterHex+ -- ** Fields+ , Fq+ , Fq2+ , Fq6+ , Fq12+ , Fr+ -- ** Groups+ , G1'+ , G2'+ , GT'+ -- ** Roots of unity+ , getRootOfUnity+ ) where++import Protolude++import Data.Curve.Weierstrass.BN254A as G1+import Data.Curve.Weierstrass.BN254AT as G2+import Data.Field.Galois as F++import Data.Pairing+import Data.Pairing.Ate++-------------------------------------------------------------------------------+-- Fields+-------------------------------------------------------------------------------++-- Cubic nonresidue in @Fq2@.+xi :: Fq2+xi = [0, 1]+{-# INLINABLE xi #-}++-- | Field of points of BN254A curve over @Fq6@.+type Fq6 = Extension V Fq2+data V+instance IrreducibleMonic V Fq2 where+ poly _ = [-xi, 0, 0, 1]+ {-# INLINABLE poly #-}++-- | Field of points of BN254A curve over @Fq12@.+type Fq12 = Extension W Fq6+data W+instance IrreducibleMonic W Fq6 where+ poly _ = [[0, -1], 0, 1]+ {-# INLINABLE poly #-}++-------------------------------------------------------------------------------+-- Curves+-------------------------------------------------------------------------------++-- | BN254A curve left group @G1 = E(Fq)@.+type G1' = G1.PA++-- | BN254A curve right group @G2 = E'(Fq2)@.+type G2' = G2.PA++-- | @Fq12@ multiplicative target group @GT@.+type GT' = RootsOfUnity R Fq12+instance CyclicSubgroup (RootsOfUnity R Fq12) where+ gen = toU'+ [ [ [ 0x4458b6bb7ef0dda02b9ad613e4409b2d6df24f0c185fa2d78123ca6f77d07da+ , 0x2231017130d2fab595f7e65d6523c9a000194b87ecaa4c7ea38fd6521afd5a71+ ]+ , [ 0xad346bd688cc084eafd4046c8917e0fa9ab4a57c38030a138d92d2c01e7aed8+ , 0x171585475d4ff21f16d98a1d4fe602600291395c2bb90410110e3d371debb5be+ ]+ , [ 0x22581de973331965d6d99e91e099f7103fc1adae7ff144b2883700e8a62c736d+ , 0x1a1aea16ea2f8a1a83bbb94f313017d4d219934299f164a4cf81d238ba1a28f7+ ]+ ]+ , [ [ 0xe13cf00937f8e3ac7a5a0fb48155d00da25dffb034dd4bcdfe0f104c4add186+ , 0x2078ec5a822a57b5f6d9588693d1f133c5fd810af9eed8f49f8f2eeeca7291ce+ ]+ , [ 0xae3a9a729c6b4499e68c37eda1d2bb5102c8cf5ebce94be9fcfac8c9e0a919f+ , 0x1f0d8b494d6cfe679c44568e3aa183442bc3b330dbed889d5fd23e72042b9563+ ]+ , [ 0x771453fb3496035abf9120d7a2f69760cc6096cea55b8734bf1e31cfb47bbbd+ , 0x7252678df761476bf642f8a9870c8c38a6c89adc2078e724188f7b7731899f3+ ]+ ]+ ]+ {-# INLINABLE gen #-}++-------------------------------------------------------------------------------+-- Pairings+-------------------------------------------------------------------------------++-- | BN254A curve parameter @s = 6t + 2@ in signed binary.+parameterBin :: [Int8]+parameterBin = [ 1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0+ , 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0+ , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0+ , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0+ ]+{-# INLINABLE parameterBin #-}++-- | BN254A curve parameter @t@ in hexadecimal.+parameterHex :: Integer+parameterHex = 0x3fc0100000000000+{-# INLINABLE parameterHex #-}++-- BN254A curve is pairing-friendly.+instance Pairing BN254A where++ type instance G1 BN254A = G1'++ type instance G2 BN254A = G2'++ type instance GT BN254A = GT'++ pairing = (.) (finalExponentiationBN parameterHex)+ . millerAlgorithmBN xi parameterBin+ {-# INLINABLE pairing #-}++-------------------------------------------------------------------------------+-- Roots of unity+-------------------------------------------------------------------------------++-- | Precompute primitive roots of unity for binary powers that divide @r - 1@.+getRootOfUnity :: Int -> Fr+getRootOfUnity 0 = 1+getRootOfUnity 1 = 16030569034403128277756688287498649515510226217719936227669524443298095169536+getRootOfUnity 2 = 3489693859167495945826266994150801934706357307593354903555+getRootOfUnity 3 = 3285903727338212256516752050919226860376724583194591055153489062260959380635+getRootOfUnity 4 = 2270555545872348511759307962351523183560262977186337590657501402287699857908+getRootOfUnity 5 = 1315072370156942873281151013996374548132532175092877209004809243239179089527+getRootOfUnity 6 = 3156020212676014144280026166857817346787625345871557368826134972222969932340+getRootOfUnity 7 = 7470724239101740420986373029747289447449046784740915971953525293322381316462+getRootOfUnity 8 = 15496266489460347899257264157305968971891080888631944276330231347438178328945+getRootOfUnity 9 = 6208678585364090833596481491575308816974565051050326042583304699099274900516+getRootOfUnity 10 = 796515107887427991933186869096395437894651103048849183011948903001294588129+getRootOfUnity 11 = 229553444980607832372975580592847411867111770105669153114319009026047689566+getRootOfUnity 12 = 10320469552241416859375342152843553688047393757297404342932446859867323430848+getRootOfUnity 13 = 2881415290328970841685261289447033704708770367211748821894107957428088839272+getRootOfUnity 14 = 2322625722969234922285093801229200180009986675201187810370257177988538146799+getRootOfUnity 15 = 5271797936540031745884034785920204801094365349300930934606337942533497715992+getRootOfUnity 16 = 5497379639823644199468923626014227736920726162404780871132077046009441828871+getRootOfUnity 17 = 4692228325300560980869201540386574542235836389265038297593418577672500818515+getRootOfUnity 18 = 11994345287481770242581984677490446412334261753963410985240697457391182314159+getRootOfUnity 19 = 3502606443509093825284480908358085456133537454462190972491980856498383164446+getRootOfUnity 20 = 13519651907130181317064728599294301997820893880375441722742380085637396813274+getRootOfUnity 21 = 3881421327062235019113442541771664926155256962922001705444401214302821256619+getRootOfUnity 22 = 12856165973329967033853942823838453467927057675554924662306612709420871237434+getRootOfUnity 23 = 9139599546834243578435669355986378334708742924990005355591331148663878897471+getRootOfUnity 24 = 4661664601773682192206691279923082111080348374869531232262038176861158702949+getRootOfUnity 25 = 3709525180785332782171154777368422244075198766350471017496881161034205298444+getRootOfUnity 26 = 1465023158884904519090295913338095428293500566287977122484287885738304885304+getRootOfUnity 27 = 7342143466883872856992304520157712891165876310466091361417063107995612776528+getRootOfUnity 28 = 14232985424354665335349545605043255054435486437116951267913584526936902984572+getRootOfUnity 29 = 15202645715456227220902578982283274974185471379804841919320704390321665511593+getRootOfUnity 30 = 14570242844365864539082801254584382183965977083519576508328512259057880191351+getRootOfUnity 31 = 12124489194579669025494570168358476039067207610761137160623928994617971352978+getRootOfUnity 32 = 9718442060030929845321135565988969997330755591893628810369169031282195485548+getRootOfUnity 33 = 13965075499833313859769837639859228559796706060489672986239848943597052983689+getRootOfUnity 34 = 10878093517899627911123755383124378638161855886233124881053647640975408380375+getRootOfUnity 35 = 8435881533388956906701822403627474797360487188253006898229971548356058895841+getRootOfUnity 36 = 11660419090175191042607011267921111859970661475035565017766326822422109704808+getRootOfUnity 37 = 13479613258966828527336495732827319975048965079999537436391314511974795113951+getRootOfUnity 38 = 12255848062519507646813918887151731798620337402496187483152725509958716707663+getRootOfUnity 39 = 1191064701498473107728525837268157158221596571314584007460879085431101032989+getRootOfUnity 40 = 7929157873712339907565714231863226177716129881382898594366876137275735512725+getRootOfUnity 41 = 878558801117149418179485141457461919292588373038232616995665969934829282730+getRootOfUnity 42 = 10023598691536594233642036976538415768177003819780468987316242524307181351110+getRootOfUnity 43 = 13768920145013244438846404581759054081571321087354902639223576775854942865536+getRootOfUnity 44 = 965470443850859442138730035344447750734927117134681333276344975479417325425+getRootOfUnity 45 = 11031593636764287520022492693862893135473941066680485901697733005752357613794+getRootOfUnity _ = panic "getRootOfUnity: exponent too big for Fr / negative"+{-# INLINABLE getRootOfUnity #-}
+ src/Data/Pairing/BN254B.hs view
@@ -0,0 +1,134 @@+{-# OPTIONS -fno-warn-orphans #-}++module Data.Pairing.BN254B+ ( module Data.Pairing+ , module Data.Pairing.Ate+ -- * BN254B curve+ , BN254B+ , parameterBin+ , parameterHex+ -- ** Fields+ , Fq+ , Fq2+ , Fq6+ , Fq12+ , Fr+ -- ** Groups+ , G1'+ , G2'+ , GT'+ -- ** Roots of unity+ , getRootOfUnity+ ) where++import Protolude++import Data.Curve.Weierstrass.BN254B as G1+import Data.Curve.Weierstrass.BN254BT as G2+import Data.Field.Galois as F++import Data.Pairing+import Data.Pairing.Ate++-------------------------------------------------------------------------------+-- Fields+-------------------------------------------------------------------------------++-- Cubic nonresidue in @Fq2@.+xi :: Fq2+xi = [1, 1]+{-# INLINABLE xi #-}++-- | Field of points of BN254B curve over @Fq6@.+type Fq6 = Extension V Fq2+data V+instance IrreducibleMonic V Fq2 where+ poly _ = [-xi, 0, 0, 1]+ {-# INLINABLE poly #-}++-- | Field of points of BN254B curve over @Fq12@.+type Fq12 = Extension W Fq6+data W+instance IrreducibleMonic W Fq6 where+ poly _ = [[0, -1], 0, 1]+ {-# INLINABLE poly #-}++-------------------------------------------------------------------------------+-- Curves+-------------------------------------------------------------------------------++-- | BN254B curve left group @G1 = E(Fq)@.+type G1' = G1.PA++-- | BN254B curve right group @G2 = E'(Fq2)@.+type G2' = G2.PA++-- | @Fq12@ multiplicative target group @GT@.+type GT' = RootsOfUnity R Fq12+instance CyclicSubgroup (RootsOfUnity R Fq12) where+ gen = toU'+ [ [ [ 0xd8a793b0defaef46557b6694e97514cc17a5ef2a410a979113e53d0644f9a5a+ , 0x1ff35a6f3bd5e17c32b319111480f860b6572335300a6f07eec69fc89a586be7+ ]+ , [ 0x221fc0405a912aa6a474d891868725ff1a821017264e02f74021107f3e32775a+ , 0x1c0c4fae54227be18b16acbc49dda4c3faafe051ea945152ad8a9bb4f5e734df+ ]+ , [ 0x11a0963c0701d5089ae418ebe84a5a97b24089c688eb91a931068a7f91db9339+ , 0x20b7dc228dd3a27f9589fae17d352de2f2a1076ff56eb716026708945f53afcf+ ]+ ]+ , [ [ 0x2984d9eb6e0fb0e6254c036c9f110c4eda9d0b47873483634e36219ef6d3667+ , 0x21bb4de1e9efc68028a58dd3b3677400c6a4edbb321a49b2554a3d94af7049ee+ ]+ , [ 0x17224135a9a5fb3989c3f4e890c01ff14c2f25bc365500e6cfa5beacf99c030b+ , 0x1e3fabd61be8363430f4b6a50ef66f4dbde24fd135bfbbce2e3e515d6f382bd5+ ]+ , [ 0x237331610f44927d30add64ca35c4d4c6dd776bb212d6eb6da29bdbdb95408f2+ , 0x23bc485aa8a38dfabb7dcb49caed2e12b5b7cdffc35f6e41bdab5df1d54d51d8+ ]+ ]+ ]+ {-# INLINABLE gen #-}++-------------------------------------------------------------------------------+-- Pairings+-------------------------------------------------------------------------------++-- | BN254B curve parameter @s = 6t + 2@ in signed binary.+parameterBin :: [Int8]+parameterBin = [-1,-1, 0, 0, 0, 0, 0,-1,-1, 0, 0, 0, 0, 0, 0, 0, 0+ , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0+ , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0+ , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-1, 0, 0+ ]+{-# INLINABLE parameterBin #-}++-- | BN254B curve parameter @t@ in hexadecimal.+parameterHex :: Integer+parameterHex = -0x4080000000000001+{-# INLINABLE parameterHex #-}++-- BN254B curve is pairing-friendly.+instance Pairing BN254B where++ type instance G1 BN254B = G1'++ type instance G2 BN254B = G2'++ type instance GT BN254B = GT'++ pairing = (.) (finalExponentiationBN parameterHex)+ . millerAlgorithmBN xi parameterBin+ {-# INLINABLE pairing #-}++-------------------------------------------------------------------------------+-- Roots of unity+-------------------------------------------------------------------------------++-- | Precompute primitive roots of unity for binary powers that divide @r - 1@.+getRootOfUnity :: Int -> Fr+getRootOfUnity 0 = 1+getRootOfUnity 1 = 1+getRootOfUnity 2 = 16798108731015832284940804142231733909759579603404752749028378864165570215948+getRootOfUnity _ = panic "getRootOfUnity: exponent too big for Fr / negative"+{-# INLINABLE getRootOfUnity #-}
+ src/Data/Pairing/BN254C.hs view
@@ -0,0 +1,134 @@+{-# OPTIONS -fno-warn-orphans #-}++module Data.Pairing.BN254C+ ( module Data.Pairing+ , module Data.Pairing.Ate+ -- * BN254C curve+ , BN254C+ , parameterBin+ , parameterHex+ -- ** Fields+ , Fq+ , Fq2+ , Fq6+ , Fq12+ , Fr+ -- ** Groups+ , G1'+ , G2'+ , GT'+ -- ** Roots of unity+ , getRootOfUnity+ ) where++import Protolude++import Data.Curve.Weierstrass.BN254C as G1+import Data.Curve.Weierstrass.BN254CT as G2+import Data.Field.Galois as F++import Data.Pairing+import Data.Pairing.Ate++-------------------------------------------------------------------------------+-- Fields+-------------------------------------------------------------------------------++-- Cubic nonresidue in @Fq2@.+xi :: Fq2+xi = [1, 1]+{-# INLINABLE xi #-}++-- | Field of points of BN254C curve over @Fq6@.+type Fq6 = Extension V Fq2+data V+instance IrreducibleMonic V Fq2 where+ poly _ = [-xi, 0, 0, 1]+ {-# INLINABLE poly #-}++-- | Field of points of BN254C curve over @Fq12@.+type Fq12 = Extension W Fq6+data W+instance IrreducibleMonic W Fq6 where+ poly _ = [[0, -1], 0, 1]+ {-# INLINABLE poly #-}++-------------------------------------------------------------------------------+-- Curves+-------------------------------------------------------------------------------++-- | BN254C curve left group @G1 = E(Fq)@.+type G1' = G1.PA++-- | BN254C curve right group @G2 = E'(Fq2)@.+type G2' = G2.PA++-- | @Fq12@ multiplicative target group @GT@.+type GT' = RootsOfUnity R Fq12+instance CyclicSubgroup (RootsOfUnity R Fq12) where+ gen = toU'+ [ [ [ 0x201b03133f54fe2bf8b6ae48a590f83fcbf60cf4ca681001aa95a6db00f50ba0+ , 0x1758b71a6863d1268c5ba9e33cdce80c10d66a9e2d98b6e20a3749389723dedd+ ]+ , [ 0x2d7c549a685216ed0dbbe6cefa86bb379d92ea53aa7b17a7be199aee82f4641+ , 0x8a261cf6b255434c19629264a760c2b4eed29fb450834408f2a76294b09d253+ ]+ , [ 0x9ab7b58c63a0cd02b5c19dff7564cadf762bf685c56d013d8d0fcd90ee1ac74+ , 0x10c1e82167537a441d0d9bc44a430f32cb6652d99707a1afb6d3fdc41e16841e+ ]+ ]+ , [ [ 0xe801b7d99eaab8a3766f1c6bea69dab74c3f8705928debb967c85faeecba31e+ , 0x2aaa88a8c47590d35be04a52aa98ab389a005cd761a4e26a0244e18adece700+ ]+ , [ 0x1f84449717982278c6ee46778aca80058914641b82d36a980c5542b7be4451e6+ , 0xeda0f13df8a542d4a958ab270ed43c393ccccf4328196e6f21e08b9c8a33891+ ]+ , [ 0x51045def1264f6fb73d28c60403d35b724e0a20f47cce88dc100216e03a3b46+ , 0xacdd532a90f3566bf0df387a766ace58d21fef93a414f30825372ebc0adb6fc+ ]+ ]+ ]+ {-# INLINABLE gen #-}++-------------------------------------------------------------------------------+-- Pairings+-------------------------------------------------------------------------------++-- | BN254C curve parameter @s = 6t + 2@ in signed binary.+parameterBin :: [Int8]+parameterBin = [-1,-1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-1,-1+ , 0, 0, 0, 0, 0, 0,-1, 0, 0,-1, 0, 0, 0, 0, 0, 0+ , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,-1+ ,-1, 0, 0, 0, 0, 0,-1,-1, 0, 0, 0, 0, 0,-1, 0, 0+ ]+{-# INLINABLE parameterBin #-}++-- | BN254C curve parameter @t@ in hexadecimal.+parameterHex :: Integer+parameterHex = -0x4000806000004081+{-# INLINABLE parameterHex #-}++-- BN254C curve is pairing-friendly.+instance Pairing BN254C where++ type instance G1 BN254C = G1'++ type instance G2 BN254C = G2'++ type instance GT BN254C = GT'++ pairing = (.) (finalExponentiationBN parameterHex)+ . millerAlgorithmBN xi parameterBin+ {-# INLINABLE pairing #-}++-------------------------------------------------------------------------------+-- Roots of unity+-------------------------------------------------------------------------------++-- | Precompute primitive roots of unity for binary powers that divide @r - 1@.+getRootOfUnity :: Int -> Fr+getRootOfUnity 0 = 1+getRootOfUnity 1 = 16285256166819790982212518231621426655034817857667267142801363550619237884172+getRootOfUnity 2 = 3531193943909383743765472579762059777732585141995099857941+getRootOfUnity _ = panic "getRootOfUnity: exponent too big for Fr / negative"+{-# INLINABLE getRootOfUnity #-}
+ src/Data/Pairing/BN254D.hs view
@@ -0,0 +1,134 @@+{-# OPTIONS -fno-warn-orphans #-}++module Data.Pairing.BN254D+ ( module Data.Pairing+ , module Data.Pairing.Ate+ -- * BN254D curve+ , BN254D+ , parameterBin+ , parameterHex+ -- ** Fields+ , Fq+ , Fq2+ , Fq6+ , Fq12+ , Fr+ -- ** Groups+ , G1'+ , G2'+ , GT'+ -- ** Roots of unity+ , getRootOfUnity+ ) where++import Protolude++import Data.Curve.Weierstrass.BN254D as G1+import Data.Curve.Weierstrass.BN254DT as G2+import Data.Field.Galois as F++import Data.Pairing+import Data.Pairing.Ate++-------------------------------------------------------------------------------+-- Fields+-------------------------------------------------------------------------------++-- Cubic nonresidue in @Fq2@.+xi :: Fq2+xi = [1, 1]+{-# INLINABLE xi #-}++-- | Field of points of BN254D curve over @Fq6@.+type Fq6 = Extension V Fq2+data V+instance IrreducibleMonic V Fq2 where+ poly _ = [-xi, 0, 0, 1]+ {-# INLINABLE poly #-}++-- | Field of points of BN254D curve over @Fq12@.+type Fq12 = Extension W Fq6+data W+instance IrreducibleMonic W Fq6 where+ poly _ = [[0, -1], 0, 1]+ {-# INLINABLE poly #-}++-------------------------------------------------------------------------------+-- Curves+-------------------------------------------------------------------------------++-- | BN254D curve left group @G1 = E(Fq)@.+type G1' = G1.PA++-- | BN254D curve right group @G2 = E'(Fq2)@.+type G2' = G2.PA++-- | @Fq12@ multiplicative target group @GT@.+type GT' = RootsOfUnity R Fq12+instance CyclicSubgroup (RootsOfUnity R Fq12) where+ gen = toU'+ [ [ [ 0x162b1d8d5992ddbc4b1076b1608602b3a438540fdc62c78d28e15fd6b6d6488c+ , 0x6a832abcf68a00ed481a0ae12884aae74b9e585eaae5f91f1273dff1b8c6fd5+ ]+ , [ 0x15a890f5d421f6d5789b7f6050ca410d198e7e1430e1d80d107e46656070a80+ , 0x1f6aab0d6ba73556752142d26c7bb6ef91b265df48c606082014f7873a1bca05+ ]+ , [ 0x9a13a2b4214af1e30eda1e9a4fdb6940e0e0fc62ca99a5d443e05f8adcbd02+ , 0xd9027e6080d657ef24a6de965df5b0b617677a4fb3aa875031bc85a42939fc+ ]+ ]+ , [ [ 0x14c86295586eb7e9e845856758b7dd1f58cfa86b54d849bfccd5bfc266b356f1+ , 0x15680ac39a5277f9c3d06881fe9326ec57556ec4a7d5bece1cc2fd9e5e3485ac+ ]+ , [ 0x173023031e9636fcb5a1cc9cdf755b5c5d6ac8d020b46f78e360204c1c5491d3+ , 0x2b1de2e77e75107774ec7b3d2f6a0f50a5826e03ab0a0ed2b0c16bae064bbbf+ ]+ , [ 0x1883ed794f464284271515eed4d7079c3b002b3b58ecda27daaa8195a4d091ee+ , 0x14f0f67248ac6b81b7aafe8a2623fe52774c5258761c5c6e96ea45df4c055681+ ]+ ]+ ]+ {-# INLINABLE gen #-}++-------------------------------------------------------------------------------+-- Pairings+-------------------------------------------------------------------------------++-- | BN254D curve parameter @s = 6t + 2@ in signed binary.+parameterBin :: [Int8]+parameterBin = [-1,-1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0+ , 0, 0, 0, 0,-1,-1, 0, 0, 0, 0, 0, 0, 0,-1,-1, 0+ , 0, 0, 0, 0, 0, 0,-1, 0, 0,-1, 0, 0, 0, 0,-1,-1+ , 0, 0, 0, 0,-1,-1, 0, 0, 0, 0, 0,-1,-1,-1, 0, 0+ ]+{-# INLINABLE parameterBin #-}++-- | BN254D curve parameter @t@ in hexadecimal.+parameterHex :: Integer+parameterHex = -0x4000020100608205+{-# INLINABLE parameterHex #-}++-- BN254D curve is pairing-friendly.+instance Pairing BN254D where++ type instance G1 BN254D = G1'++ type instance G2 BN254D = G2'++ type instance GT BN254D = GT'++ pairing = (.) (finalExponentiationBN parameterHex)+ . millerAlgorithmBN xi parameterBin+ {-# INLINABLE pairing #-}++-------------------------------------------------------------------------------+-- Roots of unity+-------------------------------------------------------------------------------++-- | Precompute primitive roots of unity for binary powers that divide @r - 1@.+getRootOfUnity :: Int -> Fr+getRootOfUnity 0 = 1+getRootOfUnity 1 = 1+getRootOfUnity 2 = 16283293667627659188681377855926356453722146030848085931720027730057779358708+getRootOfUnity _ = panic "getRootOfUnity: exponent too big for Fr / negative"+{-# INLINABLE getRootOfUnity #-}
+ src/Data/Pairing/BN462.hs view
@@ -0,0 +1,138 @@+{-# OPTIONS -fno-warn-orphans #-}++module Data.Pairing.BN462+ ( module Data.Pairing+ , module Data.Pairing.Ate+ -- * BN462 curve+ , BN462+ , parameterBin+ , parameterHex+ -- ** Fields+ , Fq+ , Fq2+ , Fq6+ , Fq12+ , Fr+ -- ** Groups+ , G1'+ , G2'+ , GT'+ -- ** Roots of unity+ , getRootOfUnity+ ) where++import Protolude++import Data.Curve.Weierstrass.BN462 as G1+import Data.Curve.Weierstrass.BN462T as G2+import Data.Field.Galois as F++import Data.Pairing+import Data.Pairing.Ate++-------------------------------------------------------------------------------+-- Fields+-------------------------------------------------------------------------------++-- Cubic nonresidue in @Fq2@.+xi :: Fq2+xi = [2, 1]+{-# INLINABLE xi #-}++-- | Field of points of BN462 curve over @Fq6@.+type Fq6 = Extension V Fq2+data V+instance IrreducibleMonic V Fq2 where+ poly _ = [-xi, 0, 0, 1]+ {-# INLINABLE poly #-}++-- | Field of points of BN462 curve over @Fq12@.+type Fq12 = Extension W Fq6+data W+instance IrreducibleMonic W Fq6 where+ poly _ = [[0, -1], 0, 1]+ {-# INLINABLE poly #-}++-------------------------------------------------------------------------------+-- Curves+-------------------------------------------------------------------------------++-- | BN462 curve left group @G1 = E(Fq)@.+type G1' = G1.PA++-- | BN462 curve right group @G2 = E'(Fq2)@.+type G2' = G2.PA++-- | @Fq12@ multiplicative target group @GT@.+type GT' = RootsOfUnity R Fq12+instance CyclicSubgroup (RootsOfUnity R Fq12) where+ gen = toU' $+ [ [ [ 0xcf7f0f2e01610804272f4a7a24014ac085543d787c8f8bf07059f93f87ba7e2a4ac77835d4ff10e78669be39cd23cc3a659c093dbe3b9647e8c+ , 0xef2c737515694ee5b85051e39970f24e27ca278847c7cfa709b0df408b830b3763b1b001f1194445b62d6c093fb6f77e43e369edefb1200389+ ]+ , [ 0x4d685b29fd2b8faedacd36873f24a06158742bb2328740f93827934592d6f1723e0772bb9ccd3025f88dc457fc4f77dfef76104ff43cd430bf7+ , 0x90067ef2892de0c48ee49cbe4ff1f835286c700c8d191574cb424019de11142b3c722cc5083a71912411c4a1f61c00d1e8f14f545348eb7462c+ ]+ , [ 0x1437603b60dce235a090c43f5147d9c03bd63081c8bb1ffa7d8a2c31d673230860bb3dfe4ca85581f7459204ef755f63cba1fbd6a4436f10ba0e+ , 0x13191b1110d13650bf8e76b356fe776eb9d7a03fe33f82e3fe5732071f305d201843238cc96fd0e892bc61701e1844faa8e33446f87c6e29e75f+ ]+ ]+ , [ [ 0x7b1ce375c0191c786bb184cc9c08a6ae5a569dd7586f75d6d2de2b2f075787ee5082d44ca4b8009b3285ecae5fa521e23be76e6a08f17fa5cc8+ , 0x5b64add5e49574b124a02d85f508c8d2d37993ae4c370a9cda89a100cdb5e1d441b57768dbc68429ffae243c0c57fe5ab0a3ee4c6f2d9d34714+ ]+ , [ 0xfd9a3271854a2b4542b42c55916e1faf7a8b87a7d10907179ac7073f6a1de044906ffaf4760d11c8f92df3e50251e39ce92c700a12e77d0adf3+ , 0x17fa0c7fa60c9a6d4d8bb9897991efd087899edc776f33743db921a689720c82257ee3c788e8160c112f18e841a3dd9a79a6f8782f771d542ee5+ ]+ , [ 0xc901397a62bb185a8f9cf336e28cfb0f354e2313f99c538cdceedf8b8aa22c23b896201170fc915690f79f6ba75581f1b76055cd89b7182041c+ , 0x20f27fde93cee94ca4bf9ded1b1378c1b0d80439eeb1d0c8daef30db0037104a5e32a2ccc94fa1860a95e39a93ba51187b45f4c2c50c16482322+ ]+ ]+ ]+ {-# INLINABLE gen #-}++-------------------------------------------------------------------------------+-- Pairings+-------------------------------------------------------------------------------++-- | BN462 curve parameter @s = 6t + 2@ in signed binary.+parameterBin :: [Int8]+parameterBin = [ 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0+ , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0+ , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0+ , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0+ , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0+ , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0+ , 0, 0,-1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0+ , 0,-1, 0, 0+ ]+{-# INLINABLE parameterBin #-}++-- | BN462 curve parameter @t@ in hexadecimal.+parameterHex :: Integer+parameterHex = 0x4001fffffffffffffffffffffbfff+{-# INLINABLE parameterHex #-}++-- BN462 curve is pairing-friendly.+instance Pairing BN462 where++ type instance G1 BN462 = G1'++ type instance G2 BN462 = G2'++ type instance GT BN462 = GT'++ pairing = (.) (finalExponentiationBN parameterHex)+ . millerAlgorithmBN xi parameterBin+ {-# INLINABLE pairing #-}++-------------------------------------------------------------------------------+-- Roots of unity+-------------------------------------------------------------------------------++-- | Precompute primitive roots of unity for binary powers that divide @r - 1@.+getRootOfUnity :: Int -> Fr+getRootOfUnity 0 = 1+getRootOfUnity 1 = 6701817056313037086248947066310538444882082605308124576230408038843354961099564416871567745979441241809893679037520753402159179772451651596+getRootOfUnity 2 = 6701817056313037086248947066310538122240713774066876784715216358244698888639313144783432601961772704202466509837286441148448873569895743522+getRootOfUnity _ = panic "getRootOfUnity: exponent too big for Fr / negative"+{-# INLINABLE getRootOfUnity #-}
+ src/Data/Pairing/Hash.hs view
@@ -0,0 +1,89 @@+module Data.Pairing.Hash+ ( module Data.Pairing+ -- * Shallue-van de Woestijne encoding to BLS12 curves+ , swEncBLS12+ -- * Shallue-van de Woestijne encoding to BN curves+ , swEncBN+ ) where++import Protolude++import Control.Error (hoistMaybe, runMaybeT)+import Control.Monad.Random (MonadRandom)+import qualified Data.ByteString as B (foldl')+import Data.Curve.Weierstrass+import Data.Field.Galois as F hiding ((/))+import Data.List ((!!))++import Data.Pairing++-------------------------------------------------------------------------------+-- Shallue-van de Woestijne encoding+-------------------------------------------------------------------------------++-- | Encodes a given byte string to a point on the BLS12 curve.+--+-- The implementation uses the Shallue-van de Woestijne encoding to BLS12 curves+-- as specified in Section 3 of [Fast and simple constant-time hashing to the+-- BLS12-381 elliptic curve](https://eprint.iacr.org/2019/403.pdf).+--+-- This function is not implemented yet.+swEncBLS12 :: forall e m q r u v w . (MonadRandom m, ECPairing e q r u v w)+ => ByteString -> m (Maybe (G1 e))+swEncBLS12 = panic "swEncBLS12: not implemented."+{-# INLINABLE swEncBLS12 #-}++-- | Encodes a given byte string to a point on the BN curve.+--+-- The implementation uses the Shallue-van de Woestijne encoding to BN curves+-- as specified in Section 6 of [Indifferentiable Hashing to Barreto-Naehrig Curves]+-- (https://www.di.ens.fr/~fouque/pub/latincrypt12.pdf).+-- +-- This function evaluates an empty bytestring or one that contains \NUL+-- to zero and is sent to an arbitrary point on the curve.+swEncBN :: forall e m q r u v w . (MonadRandom m, ECPairing e q r u v w)+ => ByteString -> m (Maybe (G1 e))+swEncBN bs = runMaybeT $ do+ sqrt3 <- hoistMaybe $ sr $ -3+ let t = fromBytes bs+ s1 = (sqrt3 - 1) / 2+ b1 = 1 + b_ (witness :: G1 e)+ guard (b1 + t * t /= 0)+ if t == 0 then -- arbitrary point on the curve+ if b1 == 3 then+ return $ A (-1) 1 -- 1^2 = (-1)^3 + 2+ else if b1 == 4 then+ return $ A 1 2 -- 2^2 = 1^3 + 3+ else if b1 == 6 then+ return $ A (-1) 2 -- 2^2 = (-1)^3 + 5+ else+ A s1 <$> hoistMaybe (sr b1) -- definition 2 assuming 1 + b is a quadratic residue+ else do+ let w = sqrt3 * t / (b1 + t * t)+ x1 = s1 - t * w+ x2 = -1 - x1+ x3 = 1 + 1 / (w * w)+ r1 <- F.rnd+ r2 <- F.rnd+ r3 <- F.rnd+ let a = ch $ r1 * r1 * (x1 * x1 * x1 + b_ (witness :: G1 e))+ b = ch $ r2 * r2 * (x2 * x2 * x2 + b_ (witness :: G1 e))+ c = ch $ r3 * r3 * t+ i = mod ((a - 1) * b) 3+ x = [x1, x2, x3] !! i+ y = sr $ x * x * x + b_ (witness :: G1 e)+ A x . (fromIntegral c *) <$> hoistMaybe y+ where+ ch x = if x == 0 then 0 else if qr x then 1 else -1 :: Int+{-# INLINABLE swEncBN #-}++-------------------------------------------------------------------------------+-- Auxiliary functions+-------------------------------------------------------------------------------++-- Conversion from bytestring to field.+fromBytes :: (Bits k, Num k) => ByteString -> k+fromBytes = B.foldl' f 0+ where+ f a b = shiftL a 8 .|. fromIntegral b+{-# INLINABLE fromBytes #-}
− src/Pairing/ByteRepr.hs
@@ -1,127 +0,0 @@-module Pairing.ByteRepr- ( ByteOrder(..)- , ByteOrderLength(..)- , ByteRepr(..)- , fromBytesToInteger- , toBytes- , toPaddedBytes- ) where--import Protolude--import qualified Data.ByteString as B-import PrimeField (toInt)-import ExtensionField (fromField, toField)--import Pairing.Curve (Fq, Fq2, Fq6, Fq12)------------------------------------------------------------------------------------ Bytes----------------------------------------------------------------------------------data ByteOrder = MostSignificantFirst- | LeastSignificantFirst--type ElementLength = Int--data ByteOrderLength = ByteOrderLength- { byteOrder :: ByteOrder- , lenPerElement :: ElementLength- }--class ByteRepr a where- mkRepr :: ByteOrderLength -> a -> Maybe ByteString- fromRepr :: ByteOrderLength -> a -> ByteString -> Maybe a- calcReprLength :: a -> ElementLength -> Int--toBytes :: Integer -> ByteString-toBytes x = B.reverse . B.unfoldr (fmap go) . Just $ changeSign x- where- changeSign :: Num a => a -> a- changeSign | x < 0 = subtract 1 . negate- | otherwise = identity- go :: Integer -> (Word8, Maybe Integer)- go y = (b, i)- where- b = changeSign (fromInteger y)- i | y >= 128 = Just (y `shiftR` 8)- | otherwise = Nothing--toPaddedBytes :: ByteOrderLength -> Integer -> Maybe ByteString-toPaddedBytes bo a = case byteOrder bo of- LeastSignificantFirst -> B.reverse <$> mkbs (toBytes a)- MostSignificantFirst -> mkbs (toBytes a)- where- mkbs bs- | B.length bs > lenPerElement bo = Nothing- | B.length bs == lenPerElement bo = Just bs- | otherwise = Just (B.append (B.replicate (lenPerElement bo - B.length bs) 0x0) bs)--fromBytesToInteger :: ByteOrder -> ByteString -> Integer-fromBytesToInteger MostSignificantFirst = B.foldl' f 0- where- f a b = a `shiftL` 8 .|. fromIntegral b-fromBytesToInteger LeastSignificantFirst = (fromBytesToInteger MostSignificantFirst) . B.reverse------------------------------------------------------------------------------------ Fields----------------------------------------------------------------------------------instance ByteRepr Fq where- mkRepr bo = toPaddedBytes bo <$> toInt- fromRepr bo _ bs = Just (fromInteger (fromBytesToInteger (byteOrder bo) bs))- calcReprLength _ n = n--instance ByteRepr Fq2 where- mkRepr bo f2 = foldl' (<>) mempty (map (mkRepr bo) (fq2Bytes f2))- where- fq2Bytes w = case fromField w of- [x, y] -> [x, y]- [x] -> [x, 0]- [] -> [0, 0]- _ -> panic "unreachable."- fromRepr bo _ bs = do- let- blen = calcReprLength (1 :: Fq) $ lenPerElement bo- (xbs, ybs) = B.splitAt blen bs- x <- fromRepr bo (1 :: Fq) xbs- y <- fromRepr bo (1 :: Fq) ybs- return (toField [x, y])- calcReprLength _ n = 2 * calcReprLength (1 :: Fq) n--instance ByteRepr Fq6 where- mkRepr bo f6 = foldl' (<>) mempty (map (mkRepr bo) (fq6Bytes f6))- where- fq6Bytes w = case fromField w of- [x, y, z] -> [x, y, z]- [x, y] -> [x, y, 0]- [x] -> [x, 0, 0]- [] -> [0, 0, 0]- _ -> panic "unreachable."- fromRepr bo _ bs = do- let- blen = calcReprLength (1 :: Fq2) $ lenPerElement bo- (xbs, yzbs) = B.splitAt blen bs- (ybs, zbs) = B.splitAt blen yzbs- x <- fromRepr bo (1 :: Fq2) xbs- y <- fromRepr bo (1 :: Fq2) ybs- z <- fromRepr bo (1 :: Fq2) zbs- return (toField [x, y, z])- calcReprLength _ n = 3 * calcReprLength (1 :: Fq2) n--instance ByteRepr Fq12 where- mkRepr bo f12 = foldl' (<>) mempty (map (mkRepr bo) (fq12Bytes f12))- where- fq12Bytes w = case fromField w of- [x, y] -> [x, y]- [x] -> [x, 0]- [] -> [0, 0]- _ -> panic "unreachable."- fromRepr bo _ bs = do- let- blen = calcReprLength (1 :: Fq6) $ lenPerElement bo- (xbs, ybs) = B.splitAt blen bs- x <- fromRepr bo (1 :: Fq6) xbs- y <- fromRepr bo (1 :: Fq6) ybs- return (toField [x, y])- calcReprLength _ n = 2 * calcReprLength (1 :: Fq6) n
− src/Pairing/Curve.hs
@@ -1,285 +0,0 @@-module Pairing.Curve- (- -- * Galois fields- Fq- , Fq2- , Fq6- , Fq12- , Fr- -- * Elliptic curves- , G1- , G2- , G2'- , GT- , gG1- , gG2- , gGT- , rG1- , rG2- , rGT- -- * Parameters- , _a- , _a'- , _b- , _b'- , _k- , _nqr- , _q- , _r- , _t- , _xi- -- * Miscellaneous functions- , conj- , getYfromX- , scale- , mulXi- , fq12Frobenius- , isRootOfUnity- , isPrimitiveRootOfUnity- , primitiveRootOfUnity- , precompRootOfUnity- -- , fromByteStringG1- -- , fromByteStringG2- -- , fromByteStringGT- ) where--import Protolude--import Curve (Curve(..))-import qualified Curve.Weierstrass.BN254 as BN254-import qualified Curve.Weierstrass.BN254T as BN254T-import ExtensionField (ExtensionField, IrreducibleMonic, fromField, toField)-import GaloisField (GaloisField(..))-import qualified Group.Field.BN254TF as BN254TF---- import Pairing.Serialize.Types------------------------------------------------------------------------------------ Galois fields------------------------------------------------------------------------------------ | Prime field @Fq@.-type Fq = BN254.Fq---- | Quadratic extension field of @Fq@ defined as @Fq2 = Fq[u]/<u^2 + 1>@.-type Fq2 = BN254T.Fq2---- | Cubic extension field of @Fq2@ defined as @Fq6 = Fq2[v]/<v^3 - (9 + u)>@.-type Fq6 = BN254TF.Fq6---- | Quadratic extension field of @Fq6@ defined as @Fq12 = Fq6[w]/<w^2 - v>@.-type Fq12 = BN254TF.Fq12---- | Prime field @Fr@.-type Fr = BN254.Fr------------------------------------------------------------------------------------ Elliptic curves------------------------------------------------------------------------------------ | G1 is @E(Fq)@ defined by @y^2 = x^3 + b@.-type G1 = BN254.PA---- | G2 is @E'(Fq2)@ defined by @y^2 = x^3 + b / xi@.-type G2 = BN254T.PA---- | G2' is G2 in Jacobian coordinates.-type G2' = BN254T.PJ---- | GT is subgroup of @r@-th roots of unity of the multiplicative group of @Fq12@.-type GT = BN254TF.P---- | Generator of G1.-gG1 :: G1-gG1 = BN254.gA---- | Generator of G2.-gG2 :: G2-gG2 = BN254T.gA---- | Generator of GT.-gGT :: GT-gGT = BN254TF.g_---- | Order of G1.-rG1 :: Integer-rG1 = BN254._r---- | Order of G2.-rG2 :: Integer-rG2 = BN254T._r---- | Order of GT.-rGT :: Integer-rGT = BN254TF._r------------------------------------------------------------------------------------ Parameters------------------------------------------------------------------------------------ | Elliptic curve @E(Fq)@ coefficient @A@, with @y = x^3 + Ax + B@.-_a :: Fq-_a = BN254._a---- | Elliptic curve @E(Fq2)@ coefficient @A'@, with @y = x^3 + A'x + B'@.-_a' :: Fq2-_a' = BN254T._a---- | Elliptic curve @E(Fq)@ coefficient @B@, with @y = x^3 + Ax + B@.-_b :: Fq-_b = BN254._b---- | Elliptic curve @E(Fq2)@ coefficient @B'@, with @y = x^3 + A'x + B'@.-_b' :: Fq2-_b' = BN254T._b---- | Embedding degree.-_k :: Integer-_k = 12---- | Quadratic nonresidue in @Fq@.-_nqr :: Integer-_nqr = 21888242871839275222246405745257275088696311157297823662689037894645226208582---- | Characteristic of finite fields.-_q :: Integer-_q = BN254._q---- | Order of G1 and characteristic of prime field of exponents.-_r :: Integer-_r = BN254._r---- | BN parameter that determines the prime @_q@.-_t :: Integer-_t = 4965661367192848881---- | Parameter of twisted curve over @Fq@.-_xi :: Fq2-_xi = toField [9, 1]------------------------------------------------------------------------------------ Miscellaneous functions------------------------------------------------------------------------------------ | Conjugation.-conj :: forall k im . IrreducibleMonic k im- => ExtensionField k im -> ExtensionField k im-conj x- | deg x /= 2 * deg (witness :: k) = panic "conj: extension degree is not two."- | otherwise = case fromField x of- [y, z] -> toField [y, negate z]- [y] -> toField [y]- [] -> 0- _ -> panic "conj: unreachable."-{-# INLINABLE conj #-}---- | Get Y coordinate from X coordinate given a curve and a choice function.-getYfromX :: Curve f c e q r => Point f c e q r -> (q -> q -> q) -> q -> Maybe q-getYfromX curve choose x = choose <*> negate <$> yX curve x-{-# INLINABLE getYfromX #-}---- | Scalar multiplication.-scale :: IrreducibleMonic k im => k -> ExtensionField k im -> ExtensionField k im-scale = (*) . toField . return-{-# INLINABLE scale #-}------------------------------------------------------------------------------------ Miscellaneous functions (temporary)------------------------------------------------------------------------------------ | Multiply by @_xi@ (cubic nonresidue in @Fq2@) and reorder coefficients.-mulXi :: Fq6 -> Fq6-mulXi w = case fromField w of- [x, y, z] -> toField [z * _xi, x, y]- [x, y] -> toField [0, x, y]- [x] -> toField [0, x]- [] -> toField []- _ -> panic "mulXi: not exhaustive."-{-# INLINE mulXi #-}---- | Iterated Frobenius automorphism in @Fq12@.-fq12Frobenius :: Int -> Fq12 -> Fq12-fq12Frobenius i a- | i == 0 = a- | i == 1 = fastFrobenius a- | i > 1 = let prev = fq12Frobenius (i - 1) a in fastFrobenius prev- | otherwise = panic "fq12Frobenius: not defined for negative values of i."-{-# INLINABLE fq12Frobenius #-}---- | Fast Frobenius automorphism in @Fq12@.-fastFrobenius :: Fq12 -> Fq12-fastFrobenius = coll . conv [[0,2,4],[1,3,5]] . cong- where- cong :: Fq12 -> [[Fq2]]- cong = map (map conj . fromField) . fromField- conv :: [[Integer]] -> [[Fq2]] -> [[Fq2]]- conv = zipWith (zipWith (\x y -> pow _xi ((x * (_q - 1)) `div` 6) * y))- coll :: [[Fq2]] -> Fq12- coll = toField . map toField-{-# INLINABLE fastFrobenius #-}---- | Check if an element is a root of unity.-isRootOfUnity :: Integer -> Fr -> Bool-isRootOfUnity n x- | n > 0 = pow x n == 1- | otherwise = panic "isRootOfUnity: negative powers not supported."-{-# INLINABLE isRootOfUnity #-}---- | Check if an element is a primitive root of unity.-isPrimitiveRootOfUnity :: Integer -> Fr -> Bool-isPrimitiveRootOfUnity n x- | n > 0 = isRootOfUnity n x && all (\m -> not $ isRootOfUnity m x) [1 .. n - 1]- | otherwise = panic "isPrimitiveRootOfUnity: negative powers not supported."-{-# INLINABLE isPrimitiveRootOfUnity #-}---- | Compute primitive roots of unity for 2^0, 2^1, ..., 2^28. (2^28--- is the largest power of two that divides _r - 1, therefore there--- are no primitive roots of unity for higher powers of 2 in Fr.)-primitiveRootOfUnity :: Int -> Fr-primitiveRootOfUnity k- | 0 <= k && k <= 28 = 5^((_r - 1) `div` (2^k))- | otherwise = panic "primitiveRootOfUnity: no primitive root for given power of 2."-{-# INLINABLE primitiveRootOfUnity #-}---- | Precompute roots of unity.-precompRootOfUnity :: Int -> Fr-precompRootOfUnity 0 = 1-precompRootOfUnity 1 = 21888242871839275222246405745257275088548364400416034343698204186575808495616-precompRootOfUnity 2 = 21888242871839275217838484774961031246007050428528088939761107053157389710902-precompRootOfUnity 3 = 19540430494807482326159819597004422086093766032135589407132600596362845576832-precompRootOfUnity 4 = 14940766826517323942636479241147756311199852622225275649687664389641784935947-precompRootOfUnity 5 = 4419234939496763621076330863786513495701855246241724391626358375488475697872-precompRootOfUnity 6 = 9088801421649573101014283686030284801466796108869023335878462724291607593530-precompRootOfUnity 7 = 10359452186428527605436343203440067497552205259388878191021578220384701716497-precompRootOfUnity 8 = 3478517300119284901893091970156912948790432420133812234316178878452092729974-precompRootOfUnity 9 = 6837567842312086091520287814181175430087169027974246751610506942214842701774-precompRootOfUnity 10 = 3161067157621608152362653341354432744960400845131437947728257924963983317266-precompRootOfUnity 11 = 1120550406532664055539694724667294622065367841900378087843176726913374367458-precompRootOfUnity 12 = 4158865282786404163413953114870269622875596290766033564087307867933865333818-precompRootOfUnity 13 = 197302210312744933010843010704445784068657690384188106020011018676818793232-precompRootOfUnity 14 = 20619701001583904760601357484951574588621083236087856586626117568842480512645-precompRootOfUnity 15 = 20402931748843538985151001264530049874871572933694634836567070693966133783803-precompRootOfUnity 16 = 421743594562400382753388642386256516545992082196004333756405989743524594615-precompRootOfUnity 17 = 12650941915662020058015862023665998998969191525479888727406889100124684769509-precompRootOfUnity 18 = 11699596668367776675346610687704220591435078791727316319397053191800576917728-precompRootOfUnity 19 = 15549849457946371566896172786938980432421851627449396898353380550861104573629-precompRootOfUnity 20 = 17220337697351015657950521176323262483320249231368149235373741788599650842711-precompRootOfUnity 21 = 13536764371732269273912573961853310557438878140379554347802702086337840854307-precompRootOfUnity 22 = 12143866164239048021030917283424216263377309185099704096317235600302831912062-precompRootOfUnity 23 = 934650972362265999028062457054462628285482693704334323590406443310927365533-precompRootOfUnity 24 = 5709868443893258075976348696661355716898495876243883251619397131511003808859-precompRootOfUnity 25 = 19200870435978225707111062059747084165650991997241425080699860725083300967194-precompRootOfUnity 26 = 7419588552507395652481651088034484897579724952953562618697845598160172257810-precompRootOfUnity 27 = 2082940218526944230311718225077035922214683169814847712455127909555749686340-precompRootOfUnity 28 = 19103219067921713944291392827692070036145651957329286315305642004821462161904-precompRootOfUnity _ = panic "precompRootOfUnity: exponent too big for Fr / negative"-{-# INLINABLE precompRootOfUnity #-}---- fromByteStringG1 :: FromSerialisedForm u => u -> LByteString -> Either Text G1--- fromByteStringG1 unser = unserializePoint unser generatorG1 . toSL---- fromByteStringG2 :: FromSerialisedForm u => u -> LByteString -> Either Text G2--- fromByteStringG2 unser = unserializePoint unser generatorG2 . toSL---- fromByteStringGT :: FromUncompressedForm u => u -> LByteString -> Either Text GT--- fromByteStringGT unser = unserialize unser 1 . toSL
− src/Pairing/Hash.hs
@@ -1,49 +0,0 @@-module Pairing.Hash- ( swEncBN- ) where--import Protolude--import Control.Error (hoistMaybe, runMaybeT)-import Control.Monad.Random (MonadRandom)-import Curve.Weierstrass (Point(..))-import Data.List ((!!))-import GaloisField (GaloisField(..))--import Pairing.ByteRepr (ByteOrder(..), fromBytesToInteger)-import Pairing.Curve (Fq, G1, _b)---- | Encodes a given byte string to a point on the BN curve.--- The implementation uses the Shallue-van de Woestijne encoding to BN curves as--- specified in Section 6 of Indifferentiable Hashing to Barreto Naehrig Curves--- by Pierre-Alain Fouque and Mehdi Tibouchi. This function evaluates an empty--- bytestring or one that contains \NUL to zero, which according to Definition 2--- of the paper is sent to an arbitrary point on the curve.-swEncBN :: MonadRandom m => ByteString -> m (Maybe G1)-swEncBN bs = runMaybeT $ do- sqrt3 <- hoistMaybe $ sr (-3)- let t = fromInteger (fromBytesToInteger MostSignificantFirst bs)- s1 = (sqrt3 - 1) / 2- b1 = 1 + _b- guard (b1 + t * t /= 0)- if t == 0- then- A s1 <$> hoistMaybe (sr b1)- else do- let w = sqrt3 * t / (b1 + t * t)- x1 = s1 - t * w- x2 = -1 - x1- x3 = 1 + 1 / (w * w)- r1 <- rnd- r2 <- rnd- r3 <- rnd- let a = ch $ r1 * r1 * (x1 * x1 * x1 + _b)- b = ch $ r2 * r2 * (x2 * x2 * x2 + _b)- c = ch $ r3 * r3 * t- i = mod ((a - 1) * b) 3- x = [x1, x2, x3] !! i- y = sr $ x * x * x + _b- A x . (fromIntegral c *) <$> hoistMaybe y- where- ch :: Fq -> Int- ch x = if x == 0 then 0 else if qr x then 1 else -1
− src/Pairing/Pairing.hs
@@ -1,223 +0,0 @@--- | Implementation of the optimal Ate pairing on the curve BN128--module Pairing.Pairing- ( reducedPairing- , atePairing- , finalExponentiation- , finalExponentiationNaive- , frobeniusNaive- , ateLoopCountBinary- ) where--import Protolude--import Curve.Weierstrass (Curve(..), Group(..), Point(..))-import Data.List ((!!))-import ExtensionField (toField)-import GaloisField (GaloisField(..))-import Group.Field (Element(..))--import Pairing.Curve---- ell0, ellVW, ellVV-data EllCoeffs- = EllCoeffs Fq2 Fq2 Fq2- deriving (Show, Eq)---- | Optimal Ate pairing (including final exponentiation step)-reducedPairing :: G1 -> G2 -> GT-reducedPairing p@(A _ _) q@(A _ _) = finalExponentiation <$> atePairing p q-reducedPairing _ _ = F 1------------------------------------------------------------------------------------ Miller loop------------------------------------------------------------------------------------ | Optimal Ate pairing without the final exponentiation step-atePairing :: G1 -> G2 -> GT-atePairing p@(A _ _) q@(A _ _) = ateMillerLoop p (atePrecomputeG2 q)-atePairing _ _ = F 1---- | Binary expansion (missing the most-significant bit) representing--- the number 6 * _t + 2.------ > 29793968203157093288--- > = 0b11001110101111001011100000011100110111110011101100011101110101000-ateLoopCountBinary :: [Bool]-ateLoopCountBinary- = [ t, f, f, t, t, t, f, t, f, t, t, t, t, f, f, t- , f, t, t, t, f, f, f, f, f, f, t, t, t, f, f, t- , t, f, t, t, t, t, t, f, f, t, t, t, f, t, t, f- , f, f, t, t, t, f, t, t, t, f, t, f, t, f, f, f- ]- where- t = True- f = False---- | Miller loop with precomputed values for G2-ateMillerLoop :: G1 -> [EllCoeffs] -> GT-ateMillerLoop p coeffs = let- (postLoopIx, postLoopF) = foldl' (ateLoopBody p coeffs) (0, F 1) ateLoopCountBinary- almostF = mulBy024 postLoopF (prepareCoeffs coeffs p postLoopIx)- finalF = mulBy024 almostF (prepareCoeffs coeffs p (postLoopIx + 1))- in finalF--ateLoopBody :: G1 -> [EllCoeffs] -> (Int, GT) -> Bool -> (Int, GT)-ateLoopBody p coeffs (oldIx, F oldF) currentBit = let- fFirst = mulBy024 (F (pow oldF 2)) (prepareCoeffs coeffs p oldIx)- (nextIx, nextF) = if currentBit- then (oldIx + 2, mulBy024 fFirst (prepareCoeffs coeffs p (oldIx + 1)))- else (oldIx + 1, fFirst)- in (nextIx, nextF)--prepareCoeffs :: [EllCoeffs] -> G1 -> Int -> EllCoeffs-prepareCoeffs coeffs (A px py) ix =- let (EllCoeffs ell0 ellVW ellVV) = coeffs !! ix- in EllCoeffs ell0 (scale py ellVW) (scale px ellVV)-prepareCoeffs _ _ _ = panic "prepareCoeffs: received trivial point"--{-# INLINEABLE mulBy024 #-}-mulBy024 :: GT -> EllCoeffs -> GT-mulBy024 (F this) (EllCoeffs ell0 ellVW ellVV)- = let a = toField [toField [ell0, 0, ellVV], toField [0, ellVW, 0]]- in F (this * a)------------------------------------------------------------------------------------ Precomputation on G2------------------------------------------------------------------------------------ | Iterated frobenius morphisms on fields of characteristic _q,--- implemented naively-{-# SPECIALISE frobeniusNaive :: Int -> Fq2 -> Fq2 #-}-frobeniusNaive :: Num a => Int -> a -> a-frobeniusNaive i a- | i == 0 = a- | i == 1 = a ^ _q- | i > 1 = let prev = frobeniusNaive (i - 1) a- in prev ^ _q- | otherwise = panic "frobeniusNaive: received negative input"--{-# INLINEABLE mulByQ #-}-mulByQ :: G2' -> G2'-mulByQ (J x y z) = J (twistMulX * pow x _q) (twistMulY * pow y _q) (pow z _q)---- xi ^ ((_q - 1) `div` 3)-twistMulX :: Fq2-twistMulX = pow _xi ((_q - 1) `div` 3) -- Fq2--- 21575463638280843010398324269430826099269044274347216827212613867836435027261--- 10307601595873709700152284273816112264069230130616436755625194854815875713954---- xi ^ ((_q - 1) `div` 2)-twistMulY :: Fq2-twistMulY = pow _xi ((_q - 1) `div` 2) -- Fq2--- 2821565182194536844548159561693502659359617185244120367078079554186484126554--- 3505843767911556378687030309984248845540243509899259641013678093033130930403--atePrecomputeG2 :: G2 -> [EllCoeffs]-atePrecomputeG2 origPt@(A _ _)- = let- bigQ = fromA origPt- (postLoopR, postLoopCoeffs)- = runLoop bigQ- bigQ1 = mulByQ bigQ- bigQ2 = inv $ mulByQ bigQ1-- (newR, coeffs1) = mixedAdditionStepForFlippedMillerLoop bigQ1 postLoopR- (_, coeffs2) = mixedAdditionStepForFlippedMillerLoop bigQ2 newR- finalCoeffs = postLoopCoeffs ++ [coeffs1, coeffs2]- in finalCoeffs- where- -- Assumes q to have z coordinate to be 1- runLoop q = foldl' (loopBody q) (q, []) ateLoopCountBinary-- loopBody :: G2' -> (G2', [EllCoeffs]) -> Bool -> (G2', [EllCoeffs])- loopBody q (oldR, oldCoeffs) currentBit- = let- (currentR, currentCoeff) = doublingStepForFlippedMillerLoop oldR- currentCoeffs = oldCoeffs ++ [currentCoeff]- (nextR, nextCoeffs) = if currentBit- then- let (resultR, resultCoeff)- = mixedAdditionStepForFlippedMillerLoop q currentR- in (resultR, currentCoeffs ++ [resultCoeff])- else (currentR, currentCoeffs)- in (nextR, nextCoeffs)-atePrecomputeG2 _ = []--twistCoeffB :: Fq2-twistCoeffB = scale _b (1 / _xi)--doublingStepForFlippedMillerLoop :: G2' -> (G2', EllCoeffs)-doublingStepForFlippedMillerLoop (J oldX oldY oldZ)- = let- a, b, c, d, e, f, g, h, i, j, eSquared :: Fq2-- a = scale 0.5 (oldX * oldY)- b = oldY * oldY- c = oldZ * oldZ- d = c + c + c- e = twistCoeffB * d- f = e + e + e- g = scale 0.5 (b + f)- h = (oldY + oldZ) * (oldY + oldZ) - (b + c)- i = e - b- j = oldX * oldX- eSquared = e * e-- newX = a * (b - f)- newY = g * g - (eSquared + eSquared + eSquared)- newZ = b * h-- ell0 = _xi * i- ellVV = j + j + j- ellVW = - h-- in (J newX newY newZ, EllCoeffs ell0 ellVW ellVV)--mixedAdditionStepForFlippedMillerLoop :: G2' -> G2' -> (G2', EllCoeffs)-mixedAdditionStepForFlippedMillerLoop (J x2 y2 _) (J x1 y1 z1)- = let- d, e, f, g, h, i, j :: Fq2- d = x1 - (x2 * z1)- e = y1 - (y2 * z1)- f = d * d- g = e * e- h = d * f- i = x1 * f- j = h + z1 * g - (i + i)-- newX = d * j- newY = e * (i - j) - (h * y1)- newZ = z1 * h-- ell0 = _xi * (e * x2 - d * y2)- ellVV = - e- ellVW = d-- in (J newX newY newZ, EllCoeffs ell0 ellVW ellVV)------------------------------------------------------------------------------------ Final exponentiation------------------------------------------------------------------------------------ | Naive implementation of the final exponentiation step-finalExponentiationNaive :: Fq12 -> Fq12-finalExponentiationNaive f = pow f expVal- where- expVal :: Integer- expVal = div (_q ^ _k - 1) _r---- | A faster way of performing the final exponentiation step-finalExponentiation :: Fq12 -> Fq12-finalExponentiation f = pow (finalExponentiationFirstChunk f) expVal- where- expVal = div (qq * (qq - 1) + 1) _r- qq = _q * _q--finalExponentiationFirstChunk :: Fq12 -> Fq12-finalExponentiationFirstChunk f- | f == 0 = 0- | otherwise = let f1 = conj f- f2 = recip f- newf0 = f1 * f2 -- == f^(_q ^6 - 1)- in fq12Frobenius 2 newf0 * newf0 -- == f^((_q ^ 6 - 1) * (_q ^ 2 + 1))
− src/Pairing/Serialize/Jivsov.hs
@@ -1,117 +0,0 @@--- | Point serialisation using https://tools.ietf.org/id/draft-jivsov-ecc-compact-05.html--- It is unclear if 02 is smallest y or not so the following is used in the first 2 bytes--- 01 - Point at infinity--- 02 - Compressed repr i.e. x only but use smallest y on decode--- 03 - Compressed repr i.e. x only but use largest y on decode--- 04 -- Uncompressed repr i.e. x & y--module Pairing.Serialize.Jivsov where--- ( Jivsov(..)--- ) where--- --- import Protolude hiding (putByteString)--- import Pairing.Point--- import Pairing.Serialize.Types--- import Pairing.Fq--- import Data.ByteString.Builder--- import Data.ByteString as B hiding (length)--- import qualified Data.ByteString as B--- import Data.Binary.Get--- import Data.Binary.Put (Put, putWord8, putWord16le, runPut, putByteString)--- import Control.Error--- import Pairing.ByteRepr--- import Pairing.CyclicGroup--- --- data Jivsov = Jivsov--- --- instance MkCompressedForm Jivsov where--- serializeCompressed _ = toCompressedForm--- --- instance MkUncompressedForm Jivsov where--- serializePointUncompressed _ = toUncompressedForm--- serializeUncompressed _ = elementToUncompressedForm--- --- instance FromSerialisedForm Jivsov where--- unserializePoint _ = pointFromByteString--- --- instance FromUncompressedForm Jivsov where--- unserialize _ = elementReadUncompressed--- --- putCompressionType :: Word8 -> Put--- putCompressionType n = putWord8 0 >> putWord8 n--- --- getCompressionType :: Get Word8--- getCompressionType = getWord8 >> getWord8--- --- ---------------------------------------------------------------------------------- -- Element specific Serailisation--- ---------------------------------------------------------------------------------- --- elementToUncompressedForm :: (ByteRepr a) => a -> Maybe LByteString--- elementToUncompressedForm a = do--- repr <- mkRepr (ByteOrderLength MostSignificantFirst minReprLength) a--- pure $ runPut $ do--- putCompressionType 4--- putByteString repr--- --- elementReadUncompressed :: (Validate a, Show a, ByteRepr a) => a -> LByteString -> Either Text a--- elementReadUncompressed ele = parseBS runc--- where--- runc = do--- ctype <- getCompressionType--- if ctype == 4 then do--- let xlen = calcReprLength ele minReprLength--- bs <- getByteString xlen--- pure (fromRepr (ByteOrderLength MostSignificantFirst minReprLength) ele bs)--- else--- pure Nothing--- --- ---------------------------------------------------------------------------------- -- Point specific serialisation--- ---------------------------------------------------------------------------------- --- toUncompressedForm :: (ByteRepr a) => Point a -> Maybe LByteString--- toUncompressedForm (Point x y) = do--- rx <- mkRepr (ByteOrderLength MostSignificantFirst minReprLength) x--- ry <- mkRepr (ByteOrderLength MostSignificantFirst minReprLength) y--- pure $ runPut $ do--- putCompressionType 4--- putByteString rx--- putByteString ry--- toUncompressedForm Infinity = pure $ runPut (putCompressionType 1)--- --- toCompressedForm :: (ByteRepr a, FromX a, Ord a) => Point a -> Maybe LByteString--- toCompressedForm (Point x y) = do--- ny <- yFromX x max--- let yform = if ny == y then 3 else 2--- rx <- mkRepr (ByteOrderLength MostSignificantFirst minReprLength) x--- pure (runPut $ do--- putCompressionType yform--- putByteString rx)--- toCompressedForm Infinity = Just (toLazyByteString (word8 0 <> word8 1))--- --- pointFromByteString :: (Show a, Validate (Point a), ByteRepr a, FromX a, Ord a) => Point a -> LByteString -> Either Text (Point a)--- pointFromByteString (Point a _) bs = parseBS fromByteStringGet bs--- where--- fromByteStringGet = do--- ctype <- getCompressionType--- processCompressed a ctype--- pointFromByteString Infinity _ = Left "Cannot use infinity to extract from bytestring"--- --- processCompressed :: forall a . (ByteRepr a, FromX a, Ord a) => a -> Word8 -> Get (Maybe (Point a))--- processCompressed one ct--- | ct == 4 = do--- xbs <- getByteString blen--- ybs <- getByteString blen--- pure (buildPoint one (ByteOrderLength MostSignificantFirst minReprLength) xbs (ByteOrderLength MostSignificantFirst minReprLength) ybs)--- | ct == 2 = fromCompressed False--- | ct == 3 = fromCompressed True--- | ct == 1 = pure (Just Infinity)--- | otherwise = pure Nothing--- where--- blen = calcReprLength one minReprLength--- fromCompressed largestY = runMaybeT $ do--- xbs <- lift $ getByteString blen--- x <- hoistMaybe $ fromRepr (ByteOrderLength MostSignificantFirst minReprLength) one xbs--- y <- hoistMaybe $ yFromX x (\y1 y2 -> if largestY then max y1 y2 else min y1 y2)--- pure (Point x y)
− src/Pairing/Serialize/MCLWasm.hs
@@ -1,64 +0,0 @@--- | --- MCL WASM (https://github.com/herumi/mcl-wasm) serialisation support--- MCL WASM uses the following algorithm to serialise--- P = (x, y) in G1--- if P.isZero() then 64-bytes zero.--- otherwise,--- d = x.serialize()--- if (y.isOdd()) d[MSB] |= 0x80--- On analysis of the GT format, each element of GT is simply LSB serialised --- and appended as a continuous bytestring, using the element length to split --- each point--module Pairing.Serialize.MCLWasm where--- ( MCLWASM(..)--- ) where--- --- import Protolude hiding (putByteString)--- import Pairing.Serialize.Types--- import Pairing.Point--- import Pairing.ByteRepr--- import Pairing.CyclicGroup--- import Data.Binary.Put (Put, putWord8, putWord16le, runPut, putByteString)--- import Data.ByteString.Builder--- import Data.ByteString as B hiding (length)--- import qualified Data.ByteString as B--- --- data MCLWASM = MCLWASM deriving (Eq, Show)--- --- instance MkCompressedForm MCLWASM where--- serializeCompressed _ = toCompressedForm--- --- instance FromSerialisedForm MCLWASM where--- unserializePoint _ = fromCompressedForm--- --- toCompressedForm :: (ByteRepr a, FromX a) => Point a -> Maybe LByteString--- toCompressedForm (Point x y) = do--- ny <- yFromX x (\y1 y2 -> if isOdd y1 then y1 else y2)--- rx <- mkRepr (ByteOrderLength LeastSignificantFirst minReprLength) x--- bs <- if isOdd y then do--- k <- toPaddedBytes (ByteOrderLength MostSignificantFirst (calcReprLength x minReprLength)) 0x80--- pure (B.pack $ B.zipWith (.|.) rx k)--- else --- pure rx--- pure (runPut $ putByteString bs)--- toCompressedForm Infinity = Just (toLazyByteString (word8 0))--- --- fromCompressedForm :: (ByteRepr a, FromX a) => Point a -> LByteString -> Either Text (Point a)--- fromCompressedForm (Point onex _) bs = if isInfinity then pure Infinity else do--- k <- note "Padding failed" (toPaddedBytes (ByteOrderLength MostSignificantFirst (calcReprLength onex minReprLength)) 0x80)--- let --- nbs = B.pack $ B.zipWith (.&.) (toS bs) k--- (xbs, yodd) = if fromBytesToInteger MostSignificantFirst nbs == 0x80 then--- (B.pack (B.zipWith xor (toS bs) k), True)--- else--- (toS bs, False)--- x <- note "Failed to deserialise x" (fromRepr (ByteOrderLength LeastSignificantFirst minReprLength) onex xbs)--- y <- note "Failed to get y from x" (yFromX x (selOdd yodd))--- pure (Point x y)--- where--- selOdd yesOdd y1 y2 = if yesOdd then whichOdd y1 y2 else whichEven y1 y2 --- whichOdd y1 y2 = if isOdd y1 then y1 else y2--- whichEven y1 y2 = if isOdd y1 then y2 else y1--- isInfinity = fromBytesToInteger MostSignificantFirst (toS bs) == 0--- fromCompressedForm Infinity _ = Left "Cannot use infinity to extract from bytestring"
− src/Pairing/Serialize/Types.hs
@@ -1,57 +0,0 @@-{-|-Base API for Point serialisation for G1, G2 and GT--}--module Pairing.Serialize.Types where--- ( MkCompressedForm(..)--- , MkUncompressedForm(..)--- , FromSerialisedForm(..)--- , FromUncompressedForm(..)--- , minReprLength--- , buildPoint--- , parseBS--- ) where--- --- import Protolude hiding (putByteString)--- import Pairing.Point--- import Pairing.Fq--- import Data.ByteString.Builder--- import Data.ByteString as B hiding (length)--- import qualified Data.ByteString as B--- import Data.Binary.Get--- import Data.Binary.Put (Put, putWord8, putWord16le, runPut, putByteString)--- import Control.Error--- import Pairing.ByteRepr--- import Pairing.CyclicGroup--- --- class MkCompressedForm a where--- -- | The serialisation may fail if y cannot be obtained from x--- serializeCompressed :: (ByteRepr b, FromX b, Ord b) => a -> Point b -> Maybe LByteString--- --- class MkUncompressedForm a where--- serializePointUncompressed :: (ByteRepr b, FromX b, Eq b) => a -> Point b -> Maybe LByteString--- serializeUncompressed :: (ByteRepr c) => a -> c -> Maybe LByteString--- --- class FromSerialisedForm a where--- unserializePoint :: (ByteRepr b, FromX b, Ord b, Show b, Validate (Point b)) => a -> Point b -> LByteString -> Either Text (Point b)--- --- class FromUncompressedForm a where--- unserialize :: (ByteRepr b, Validate b, Eq b, Show b) => a -> b -> LByteString -> Either Text b--- --- minReprLength :: Int--- minReprLength = B.length $ toBytes p--- where--- p = natVal (witness :: Fq)--- --- buildPoint :: ByteRepr a => a -> ByteOrderLength -> ByteString -> ByteOrderLength -> ByteString -> Maybe (Point a)--- buildPoint one xlen xbs ylen ybs = do--- x <- fromRepr xlen one xbs--- y <- fromRepr ylen one ybs--- pure (Point x y)--- --- parseBS :: (Validate a, Show a) => Get (Maybe a) -> LByteString -> Either Text a--- parseBS f bs = do--- (_, _, mpt) <- first (\(_,_,err) -> toS err) (runGetOrFail f bs)--- case mpt of--- Just pt -> if isValidElement pt then (Right pt) else Left ("Element was not valid after deserialisation: " <> show pt)--- Nothing -> Left "Point could not be parsed"
+ test/Main.hs view
@@ -0,0 +1,18 @@+module Main where++import Protolude++import Test.Tasty++import Test.BLS12381+import Test.BN254+import Test.BN254A+import Test.BN254B+import Test.BN254C+import Test.BN254D+import Test.BN462++main :: IO ()+main = defaultMain $+ testGroup "Pairing" [testBLS12381, testBN254, testBN254A,+ testBN254B, testBN254C, testBN254D, testBN462]
+ test/Test/BLS12381.hs view
@@ -0,0 +1,68 @@+module Test.BLS12381 where++import Protolude++import Data.Curve.Weierstrass as C+import Data.Field.Galois as F+import Data.Pairing.BLS12381+import Test.Tasty+import Test.Tasty.HUnit++import Test.Curve+import Test.Field+import Test.Pairing++testBLS12381 :: TestTree+testBLS12381 = testGroup "BLS12381"+ [ testField "Fq" (witness :: Fq)+ , testField "Fq2" (witness :: Fq2)+ , testField "Fq6" (witness :: Fq6)+ , testField "Fq12" (witness :: Fq12)+ , testField "Fr" (witness :: Fr)+ , testCurve "G1" (C.gen :: G1')+ , testCurve "G2" (C.gen :: G2')+ , testUnity "GT" (F.gen :: GT')+ , testPairing (witness :: BLS12381)+ , testCase "Test vector" $ pairing g1 g2 @?= gt+ --, testHashBLS12 (witness :: BLS12381) -- not implemented.+ ]++g1 :: G1 BLS12381+g1 = A+ 0x17f1d3a73197d7942695638c4fa9ac0fc3688c4f9774b905a14e3a3f171bac586c55e83ff97a1aeffb3af00adb22c6bb+ 0x8b3f481e3aaa0f1a09e30ed741d8ae4fcf5e095d5d00af600db18cb2c04b3edd03cc744a2888ae40caa232946c5e7e1++g2 :: G2 BLS12381+g2 = A+ ( [ 0x24aa2b2f08f0a91260805272dc51051c6e47ad4fa403b02b4510b647ae3d1770bac0326a805bbefd48056c8c121bdb8+ , 0x13e02b6052719f607dacd3a088274f65596bd0d09920b61ab5da61bbdc7f5049334cf11213945d57e5ac7d055d042b7e+ ]+ )+ ( [ 0xce5d527727d6e118cc9cdc6da2e351aadfd9baa8cbdd3a76d429a695160d12c923ac9cc3baca289e193548608b82801+ , 0x606c4a02ea734cc32acd2b02bc28b99cb3e287e85a763af267492ab572e99ab3f370d275cec1da1aaa9075ff05f79be+ ]+ )++gt :: GT BLS12381+gt = toU'+ [ [ [ 0x1250ebd871fc0a92a7b2d83168d0d727272d441befa15c503dd8e90ce98db3e7b6d194f60839c508a84305aaca1789b6+ , 0x89a1c5b46e5110b86750ec6a532348868a84045483c92b7af5af689452eafabf1a8943e50439f1d59882a98eaa0170f+ ]+ , [ 0x31ee0cf8176faed3d5e214d37e4837b518958ee5c39b2997f01e9ffb9e533bf5cb7335184e4b9b91c232bd7551f5ef+ , 0x333fc379662be784e4ed53bc809b8c242cd5c26049b5dbe98b3e9599912e2523dbb28ca5f0764eaa9980581f5dd5f5b+ ]+ , [ 0x1434ca7627208b631fab9fe851983efa300f78c547c61f10017a080635adb658fcc639b4ed513fdb10cb2a9862a855e3+ , 0x129cac1291d7cede0e5c448a7fa1879dd6e1d4579d8748542c3a143f14588050bf3874ac39dc273dff6d6e70dadc272b+ ]+ ]+ , [ [ 0xf84ad8722c9486446b9d04ee5c12b31ca548f26fc85317fa4ae45dcacca2709ef1851df07d1c7ac4d23a6ebf1a82869+ , 0x140766a9b0c7736808ab0e3042aa7be8dd368d5062528949fb7c4413b0f51b6d7989a629b646c3ea8eed395c68774a20+ ]+ , [ 0xe83a4cf2599c26539d4183cce2597a90179aa3ac63883345c450f5245902578fd4737c27d92fcef5d7122d2718820b5+ , 0x14edc37a74f7bc0cc00ab7d3a7f085e28ebb7d2b9ba3b19a9dd51cacb1a07799f497594dbed2f8a2d9b64613f63d53f9+ ]+ , [ 0x12f6c0f91a404c38fd5629091c63e94df3020950c1adc74636d2cca650f75efe9f15ba1a87a57f85ff69a0640ea93d83+ , 0x6ecf38c504bc3b9f13ba96c27fbaa763995b521b26e8bb21f46fb401dc62936b863f0edd45760f665c063e9ba54e90c+ ]+ ]+ ]
+ test/Test/BN254.hs view
@@ -0,0 +1,68 @@+module Test.BN254 where++import Protolude++import Data.Curve.Weierstrass as C+import Data.Field.Galois as F+import Data.Pairing.BN254+import Test.Tasty+import Test.Tasty.HUnit++import Test.Curve+import Test.Field+import Test.Pairing++testBN254 :: TestTree+testBN254 = testGroup "BN254"+ [ testField "Fq" (witness :: Fq)+ , testField "Fq2" (witness :: Fq2)+ , testField "Fq6" (witness :: Fq6)+ , testField "Fq12" (witness :: Fq12)+ , testField "Fr" (witness :: Fr)+ , testCurve "G1" (C.gen :: G1')+ , testCurve "G2" (C.gen :: G2')+ , testUnity "GT" (F.gen :: GT')+ , testPairing (witness :: BN254)+ , testCase "Test vector" $ pairing g1 g2 @?= gt+ , testHashBN (witness :: BN254)+ ]++g1 :: G1 BN254+g1 = A+ 0x30644e72e131a029b85045b68181585d97816a916871ca8d3c208c16d87cfd3+ 0x15ed738c0e0a7c92e7845f96b2ae9c0a68a6a449e3538fc7ff3ebf7a5a18a2c4++g2 :: G2 BN254+g2 = A+ ( [ 0x6064e784db10e9051e52826e192715e8d7e478cb09a5e0012defa0694fbc7f5+ , 0x1014772f57bb9742735191cd5dcfe4ebbc04156b6878a0a7c9824f32ffb66e85+ ]+ )+ ( [ 0x58e1d5681b5b9e0074b0f9c8d2c68a069b920d74521e79765036d57666c5597+ , 0x21e2335f3354bb7922ffcc2f38d3323dd9453ac49b55441452aeaca147711b2+ ]+ )++gt :: GT BN254+gt = toU'+ [ [ [ 0x10227b2606c11f22f4b2dec3f69cee4332ebe2e8f869ea8ca9e6d45ce15bd110+ , 0x27d1c9dae835182b272bb25b47b0d871382c9c2765fd1f42e07edbe852830157+ ]+ , [ 0x1f5919cf59b218135aaeb137ac84c6ecf282feda6a8752ca291b7ec1d2f8bab4+ , 0x2b7e44680d35a6676223538d54abcd7bc2c54281bf0f5277c81cf5b114d3a345+ ]+ , [ 0x17e6d213292c2aa12ef3cc75aca8cb9cbd47d05086227db2dbd1262d3e89dbf0+ , 0x291a53fea204b470bb901fb184155facd6e3b44fad848d536386b73d6c31fd52+ ]+ ]+ , [ [ 0x2844ed362ecf2c491a471a18c2875fd727126a62c8151c356f81e02cff52f045+ , 0x2a8245d55a3b3f9deae9cca372912a31b88dc77cee06dfa10a717acbf758cbd5+ ]+ , [ 0x222ff2e20c4578e886027953a035cbd8784a9764bbcd353051ba9f02c4dce8ad+ , 0x8532a0a75fb0acdf508c3bdd4c7700efb3a9ae403818daad5937d9ffffaca45+ ]+ , [ 0x2e7e3a4aaef17a53de3c528319b426e35f53455107f49d7fe52de95849e7dcf6+ , 0x2ba2bc83434031012424aad830a35c459c40a0b7ce87735010db68c10b61ddcb+ ]+ ]+ ]
+ test/Test/BN254A.hs view
@@ -0,0 +1,68 @@+module Test.BN254A where++import Protolude++import Data.Curve.Weierstrass as C+import Data.Field.Galois as F+import Data.Pairing.BN254A+import Test.Tasty+import Test.Tasty.HUnit++import Test.Curve+import Test.Field+import Test.Pairing++testBN254A :: TestTree+testBN254A = testGroup "BN254A"+ [ testField "Fq" (witness :: Fq)+ , testField "Fq2" (witness :: Fq2)+ , testField "Fq6" (witness :: Fq6)+ , testField "Fq12" (witness :: Fq12)+ , testField "Fr" (witness :: Fr)+ , testCurve "G1" (C.gen :: G1')+ , testCurve "G2" (C.gen :: G2')+ , testUnity "GT" (F.gen :: GT')+ , testPairing (witness :: BN254A)+ , testCase "Test vector" $ pairing g1 g2 @?= gt+ , testHashBN (witness :: BN254A)+ ]++g1 :: G1 BN254A+g1 = A+ 0xa971735a70fbdd0f94d7d6efbbc81bea78d2d92a8510f3344038a416419ad97+ 0x9456e41754237447752a448282c0873785f724447e1299826f53ac556936d3f++g2 :: G2 BN254A+g2 = A+ ( [ 0x115231d7b49901ba97cb93b5227f7f7f438a346532893dd5fafd518950924aa9+ , 0xdf12398fb78695a50bb3499b7e23b0d9035989b91a76d13af7bc64374bfb8a6+ ]+ )+ ( [ 0x51d0e087527bc9f41379fb0272ec91e5f28ee011b183ef7d6712ef3fc9a1a66+ , 0x107e6654dc6c36e163b7867aecb98e4046084734524dbb562e73e5a811f678a+ ]+ )++gt :: GT BN254A+gt = toU'+ [ [ [ 0x6a4e0dd1f7fd2f9e5dacab02cec9ce8254925c5dc6697e153f05a242cbca8a8+ , 0x22a0e22c097aec1187087b7632c9b963b0e779bc8d09848c44d3ea95cd1c1f8c+ ]+ , [ 0x751037182b5f93bcab31b115a2c0a0dcc09c6db7602e0551dd44925f3d364b3+ , 0x4b6bffb9eb68ad6a99acf52b8aad1d17d328847c6313201a6b659c9daa5cdfe+ ]+ , [ 0x13be65d47487bf6d96c146c18855c1f87bf994f9f1048524568ea0cb9dc402ad+ , 0x1202be31eb2bdcbef9f3cc00f1b2cc35fadbe1a0d66ccbf40b024adfa84c77d1+ ]+ ]+ , [ [ 0x15f9e3d10b580ff1ab2282ef1dc39a88e06f93a18303e9520d99b86d665f5380+ , 0xa1c6d26a6d683031d95c4369db90f5fee36d5008aa498d2cb6f2dde6258cda6+ ]+ , [ 0x1611153bf02f1cf7985b98c3f3cb641d39283dba55e22d1c614568f84959c6fc+ , 0x10bef55b7539743cbeab13e49116a143302f6f28ccd71a69860cef5208483809+ ]+ , [ 0x166bd873d0c65de66300a168bbdc16f0ab1b57a0809973239f2109a7d25ad349+ , 0x14d4b5014f840144d03c0c6b6010bb246ee6a69bf704d7542fbaa8f2d2a27308+ ]+ ]+ ]
+ test/Test/BN254B.hs view
@@ -0,0 +1,68 @@+module Test.BN254B where++import Protolude++import Data.Curve.Weierstrass as C+import Data.Field.Galois as F+import Data.Pairing.BN254B+import Test.Tasty+import Test.Tasty.HUnit++import Test.Curve+import Test.Field+import Test.Pairing++testBN254B :: TestTree+testBN254B = testGroup "BN254B"+ [ testField "Fq" (witness :: Fq)+ , testField "Fq2" (witness :: Fq2)+ , testField "Fq6" (witness :: Fq6)+ , testField "Fq12" (witness :: Fq12)+ , testField "Fr" (witness :: Fr)+ , testCurve "G1" (C.gen :: G1')+ , testCurve "G2" (C.gen :: G2')+ , testUnity "GT" (F.gen :: GT')+ , testPairing (witness :: BN254B)+ , testCase "Test vector" $ pairing g1 g2 @?= gt+ , testHashBN (witness :: BN254B)+ ]++g1 :: G1 BN254B+g1 = A+ 0x2074a81d4402a0b63b947335c14b2fc3c28fea2973860f686114bec4670e4eb7+ 0x6a41108087b20038771fc89fb94a82b2006034a6e8d871b3bc284846631cbeb++g2 :: G2 BN254B+g2 = A+ ( [ 0x49eedb108b71a87bfcfc9b65eb5cf1c2f89554e02df4f8354e4a00f52183c77+ , 0x1fb93ab676140e87d97226185ba05bf5ec088a9cc76d966697cfb8fa9aa8845d+ ]+ )+ ( [ 0xcd04a1ed14ad3cdf6a1fe4453da2bb9e686a637fb3ff8e2573644cc1edf208a+ , 0x11ff7795cf59d1a1a7d6ee3c3c2dfc765def1caa9f14ea264e71bd7630a43c14+ ]+ )++gt :: GT BN254B+gt = toU'+ [ [ [ 0x3e1f2693ac6d549898c78897eb158490a4832e296f888d30140500db7bd3d12+ , 0x1ebc54a76e844eb5d352945226fb103de9ec1a4fc689b87faa66ef8aba79d3ed+ ]+ , [ 0xa5a5405542f67384d683a48c281f3676b67554ed5da1700784169a0b47a57e4+ , 0x48b66dafcaee86db4d46ab71a9fe848443ef81f488d8366a727b39698cf7201+ ]+ , [ 0x142715d6482bc6fa77377c9cbc2a51c047c16de88483d5a889c7ef4df5f03bdb+ , 0x11ee0c12164133041c3dcf312ce111c845b60092818f7b72805d4aff61427934+ ]+ ]+ , [ [ 0x22371af975dae562f686988cdbbd02702c959bbf843a1fb3c7532d07be3d7a3a+ , 0x4052ca960900684a1b26c434b2776aa70736841474c16208ccd1a7c27927e19+ ]+ , [ 0x5d259da3f3aaaa54a6ae5fe8272a5b79d7f4e5bdf3b5e3c815ad781113f7548+ , 0x843c37bc5bdbf253e3bce568f5905a63867d8836855b74cba0c800d5dc41b71+ ]+ , [ 0x13ca93e1377ef0f6dd38fc2f96dbd3e8b0922f60d1f274eac63dc1af2ee9754c+ , 0xd467f3da4fb329a5cb406d0a7b743a3a2ffcd09bf95ee8a856b94af191d96af+ ]+ ]+ ]
+ test/Test/BN254C.hs view
@@ -0,0 +1,68 @@+module Test.BN254C where++import Protolude++import Data.Curve.Weierstrass as C+import Data.Field.Galois as F+import Data.Pairing.BN254C+import Test.Tasty+import Test.Tasty.HUnit++import Test.Curve+import Test.Field+import Test.Pairing++testBN254C :: TestTree+testBN254C = testGroup "BN254C"+ [ testField "Fq" (witness :: Fq)+ , testField "Fq2" (witness :: Fq2)+ , testField "Fq6" (witness :: Fq6)+ , testField "Fq12" (witness :: Fq12)+ , testField "Fr" (witness :: Fr)+ , testCurve "G1" (C.gen :: G1')+ , testCurve "G2" (C.gen :: G2')+ , testUnity "GT" (F.gen :: GT')+ , testPairing (witness :: BN254C)+ , testCase "Test vector" $ pairing g1 g2 @?= gt+ , testHashBN (witness :: BN254C)+ ]++g1 :: G1 BN254C+g1 = A+ 0x8a9143801f541142f89e498a1c06ba0959b8f9713abda0881e5de80d8aff11a+ 0x17df54e2be5e8afeb9a42f412825f79c32841307471fb2b6a14e3a0fc6e010f4++g2 :: G2 BN254C+g2 = A+ ( [ 0x21794a9da7b34b2c1614315d7d90a282c484c8fd49c0c8ba75b079ae3047d566+ , 0x1a9b474c4519e6faee5b32c7cb65547d8707137bca00c9c182d10b7e3e305936+ ]+ )+ ( [ 0xb00d54bf5a298d0eacdefb0efdb74d1a7e744722f61cc8844884fcce20ff876+ , 0x5ecf8bd02e1f5363c8402163c9a235df56b133cc2c8a926c0e65e985d746b7b+ ]+ )++gt :: GT BN254C+gt = toU'+ [ [ [ 0x13d3127ba07feffc8c1a608afc58a33a25148176968ef0ec0a2e09b62344f984+ , 0x1774dfc7361e1d4cd2de4bf62cd9b460f0a78487e75994f9e2551fed2f9d2b78+ ]+ , [ 0x2c7888f053123b5a815125b2c409e3f986594f6c35585cfb1ed1a1cbbd2ea65+ , 0xe7e7af51c459f6e0ef489348664bc4277e023a5031bee98658d5b357c07d7e8+ ]+ , [ 0x8d0f0dd32f31d3624dd9e179233a1f2f2d13cc1869f2eb933cd3cded75efe0d+ , 0x63e676f8cc5be53e8718cc9e61a8c5a018ac47e3a66f83f4c403ec8caaa130e+ ]+ ]+ , [ [ 0x1643c6ec6cf54a1970bfea19c55e34a312eb5c825f8d31354200d29339d2ca61+ , 0xaae41d356d24b0234dc2b714b595aa297f585bbe9a7c4840d58d62cdfaa1764+ ]+ , [ 0x1ea5e2efa342adcbc3ac757254d03bfde32ef6a8445bfa6a7b13aee776430594+ , 0x3aa5bc92f95887ce42ef03e666dd1455d640a031b062ed7a65fbf0a59d996b8+ ]+ , [ 0xf7735a9655207b2fe6e8e73d8f8c3f79f8a08aaeb670e6b9059d8f0739891ec+ , 0x1a501fad47a0406e50b705a544377ee1ad7518adbbb49cbe30ce31770ae9be2e+ ]+ ]+ ]
+ test/Test/BN254D.hs view
@@ -0,0 +1,68 @@+module Test.BN254D where++import Protolude++import Data.Curve.Weierstrass as C+import Data.Field.Galois as F+import Data.Pairing.BN254D+import Test.Tasty+import Test.Tasty.HUnit++import Test.Curve+import Test.Field+import Test.Pairing++testBN254D :: TestTree+testBN254D = testGroup "BN254D"+ [ testField "Fq" (witness :: Fq)+ , testField "Fq2" (witness :: Fq2)+ , testField "Fq6" (witness :: Fq6)+ , testField "Fq12" (witness :: Fq12)+ , testField "Fr" (witness :: Fr)+ , testCurve "G1" (C.gen :: G1')+ , testCurve "G2" (C.gen :: G2')+ , testUnity "GT" (F.gen :: GT')+ , testPairing (witness :: BN254D)+ , testCase "Test vector" $ pairing g1 g2 @?= gt+ , testHashBN (witness :: BN254D)+ ]++g1 :: G1 BN254D+g1 = A+ 0x1bec8eae1f1d3959e394588e49d09f2d3070efda1f836640288cf21af5488765+ 0x2d148d39f9edf5325d9a1f4820774930675669a6fe20284e435f4bfe3d3273c++g2 :: G2 BN254D+g2 = A+ ( [ 0xd62cf33cd0e46fdc338cfab52ca5cdebf1a9348e4460545441584ff4f8dc275+ , 0x22701025e0cd2bfed4518febe8e7fa97a3c7f33f2fdd280e24d651be9d17d7a8+ ]+ )+ ( [ 0x1cc6cbd065535e7f83be0cfc4f39d4687558fc21dcdc6e46aca508c4f6cc1f90+ , 0x86ee46779f9e9922a870137d033e484ec5c5ba979b75bba179064abff0cf2a+ ]+ )++gt :: GT BN254D+gt = toU'+ [ [ [ 0x20f263ae42e42cfd53cf99dc238ed7b61951c1c767af88a72ad3c19ca54cdb2d+ , 0xa96b263aade3501f7201808028c4ce11793dd84127d80525fa57f892d3043f6+ ]+ , [ 0x3a31ca4864d996d64181d9a0b025e7368d60b1f53a8276a2c39e02a58b6636e+ , 0x2301fe7eb607f6dd63b72979753c96d23fdd487f11677644884f86a83c837174+ ]+ , [ 0xcbe52ab6e1c210cf80215816f38d8964c45347bd3802c66d85e616ca9786dde+ , 0x1c039dee75146d8ae6812568e77d11cfa060d11e0224dc6e28606bfb14090650+ ]+ ]+ , [ [ 0x2344fb2b5dd57710d54458383cd33bd8f928babfe6f7d641887a565790b88e24+ , 0x8e48a543c2a73cca42811a2fea2e79eb3e628e27e54a477b5e1652466629608+ ]+ , [ 0x96a48564f586e1d59d8a9393730824b885818e93a3ce4bfae057682efc37aeb+ , 0x17260fa31ed89d4e90d7a1a2652379e4329927e61f15b11a2ce2a93c84050245+ ]+ , [ 0x5bd893369435b63a10384db8248dab8908f2173e166129d0cccd6d37c89dce6+ , 0x2a4dec6bbfe98df2c9169b06410c329d4c699747ca649e611d9960416d615b5+ ]+ ]+ ]
+ test/Test/BN462.hs view
@@ -0,0 +1,68 @@+module Test.BN462 where++import Protolude++import Data.Curve.Weierstrass as C+import Data.Field.Galois as F+import Data.Pairing.BN462+import Test.Tasty+import Test.Tasty.HUnit++import Test.Curve+import Test.Field+import Test.Pairing++testBN462 :: TestTree+testBN462 = testGroup "BN462"+ [ testField "Fq" (witness :: Fq)+ , testField "Fq2" (witness :: Fq2)+ , testField "Fq6" (witness :: Fq6)+ , testField "Fq12" (witness :: Fq12)+ , testField "Fr" (witness :: Fr)+ , testCurve "G1" (C.gen :: G1')+ , testCurve "G2" (C.gen :: G2')+ , testUnity "GT" (F.gen :: GT')+ , testPairing (witness :: BN462)+ , testCase "Test vector" $ pairing g1 g2 @?= gt+ , testHashBN (witness :: BN462)+ ]++g1 :: G1 BN462+g1 = A+ 0x17f1d3a73197d7942695638c4fa9ac0fc3688c4f9774b905a14e3a3f171bac586c55e83ff97a1aeffb3af00adb22c6bb+ 0x8b3f481e3aaa0f1a09e30ed741d8ae4fcf5e095d5d00af600db18cb2c04b3edd03cc744a2888ae40caa232946c5e7e1++g2 :: G2 BN462+g2 = A+ ( [ 0x257ccc85b58dda0dfb38e3a8cbdc5482e0337e7c1cd96ed61c913820408208f9ad2699bad92e0032ae1f0aa6a8b48807695468e3d934ae1e4df+ , 0x1d2e4343e8599102af8edca849566ba3c98e2a354730cbed9176884058b18134dd86bae555b783718f50af8b59bf7e850e9b73108ba6aa8cd283+ ]+ )+ ( [ 0xa0650439da22c1979517427a20809eca035634706e23c3fa7a6bb42fe810f1399a1f41c9ddae32e03695a140e7b11d7c3376e5b68df0db7154e+ , 0x73ef0cbd438cbe0172c8ae37306324d44d5e6b0c69ac57b393f1ab370fd725cc647692444a04ef87387aa68d53743493b9eba14cc552ca2a93a+ ]+ )++gt :: GT BN462+gt = toU'+ [ [ [ 0x20d8ed3e15698fb066a1d8a508cd46a475cb6688737257bbffb85e22f0ec9392aa0bada8ecb57ce044665682e6269fabe95cf2c479b5fc2ab87d+ , 0x203f033d08df4f09977fd95a6af3661725fad38323e746500e3a3791a8269204002fcfa7f6db2c07a8f2e624c3d1d20af166be979a7d4f3326d6+ ]+ , [ 0x7459648ba91d4f45e6f376af9ef831c108e6a5ce944f5c04902e84e69c4f7b47189e21027136ed3ad15b3ea6b3b2a6441fbbefde5825cf7910b+ , 0x136e749d9e8f9f08c620c3f15f1cacb4023471cc8ef81db71366bdade4d709990705cb040e1b89181d17b734977787a164a246a4a6f830c9d2f9+ ]+ , [ 0xab03d781bd2b229db23bb5dc21a7fa22e8a98708fecb68fe37c6da6ae74f7d2375681029edbf4571c3bd2df0f79702b8f5bd6453fbf8f4d7d26+ , 0x22874d7e6cbc799f4635bd30ec1373e9c89660578299ac7ab21fcaedf6eb4abc598247180a12195c846e9735452f7915c87ffdf8668a4cf36b4f+ ]+ ]+ , [ [ 0x1185fb88aa35f6b8ce1d6d7dec256bb65c1db5e83af23a9ed19a99a710631540bf9a581fbccd97b7d48575404bc9366eaaa9fb5c9d696fd99780+ , 0xf8bb650d0fb31261038d3a107be2e8bb88576ceb4ab786408d06a0a42b6946c560dd344389bb086b171a26bf09eb3f7b4cd069b62a5f5523f4d+ ]+ , [ 0xf49d900defd9f72e22e94c6d09d91cc7f60627e7703b311313a3236b6da1380d2b36ba2bed7d5751d4866e6db4dd5851d4529f1720ee0cdb8b+ , 0x1927caa5b25f900acc5a94dd1402bd9a8e962b3a62f4a7a46b86a618066b43594e47e0d8133743a707622f70a89657e077a5203325911a04ae24+ ]+ , [ 0x1bd405efdcd5138d382623f8f88dbd1c0ee587161cc416c8f59ffb60c50e596e3d6ec180b95dc6e45f9e29893c0ffe7994de21dcb3a7de7d6288+ , 0xa086a986923a1c96fabc8d18071cc77b8cd2c46b64344f6cfb8f98ddd4c8b361b739e6ea93f27f00a3b6b6237be434d7f0e3ab19bd8afd1172c+ ]+ ]+ ]
+ test/Test/Curve.hs view
@@ -0,0 +1,59 @@+module Test.Curve where++import Protolude++import Data.Curve+import Data.Group+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck++import Test.Field++doubleIdentities :: (Eq a, Eq b) => (a -> b) -> (b -> a) -> a -> b -> Bool+doubleIdentities f t e e' = f e == e' && t e' == e++doubleDefined :: (a -> Bool) -> (b -> Bool) -> (b -> a) -> b -> Bool+doubleDefined d d' t x = d' x && d (t x)++doubleInverses :: (Eq a, Eq b) => (a -> b) -> (b -> a) -> b -> Bool+doubleInverses f t x = f (t x) == x && t (f (t x)) == t x++doubleHomeomorphism :: (Eq a, Eq b) => (a -> a) -> (b -> b) -> (a -> b) -> (b -> a) -> b -> Bool+doubleHomeomorphism op op' f t x = t (op' x) == op (t x) && f (op (t x)) == op' x++curveAxioms :: forall f c e q r . (Curve f 'Affine e q r, Curve f c e q r)+ => Point f c e q r -> TestTree+curveAxioms g = testGroup "Curve axioms"+ [ testCase "identity closure" $+ def (mempty :: Point f c e q r) @?= True+ , testProperty "point closure" $+ (def :: Point f c e q r -> Bool)+ , testProperty "inversion closure" $+ def . (inv :: Point f c e q r -> Point f c e q r)+ , testProperty "addition closure" $+ (.) def . ((<>) :: Point f c e q r -> Point f c e q r -> Point f c e q r)+ , testProperty "doubling closure" $+ def . (join (<>) :: Point f c e q r -> Point f c e q r)+ , testProperty "multiplication closure" $+ def . (flip mul' (-3 :: Int) :: Point f c e q r -> Point f c e q r)+ , testCase "discriminant is nonzero" $+ disc g /= 0 @?= True+ , testCase "generator is well-defined" $+ def g @?= True+ , testCase "affine transformation is doubly identity-preserving" $+ doubleIdentities fromA (toA :: Point f c e q r -> Point f 'Affine e q r) mempty mempty @?= True+ , testProperty "affine transformation is doubly well-defined" $+ doubleDefined def def (toA :: Point f c e q r -> Point f 'Affine e q r)+ , testProperty "affine transformation is doubly invertible" $+ doubleInverses fromA (toA :: Point f c e q r -> Point f 'Affine e q r)+ , testProperty "affine transformation is doubly homeomorphic" $+ doubleHomeomorphism (flip mul 3) (flip mul 3) fromA (toA :: Point f c e q r -> Point f 'Affine e q r)+ ]++testCurve :: forall f c e q r . (Curve f c e q r, Curve f 'Affine e q r)+ => TestName -> Point f c e q r -> TestTree+testCurve s g = testGroup s+ [ testGroup "Group axioms" $ groupAxioms (<>) invert (mempty :: Point f c e q r) (const True)+ , curveAxioms g+ ]
+ test/Test/Field.hs view
@@ -0,0 +1,73 @@+module Test.Field where++import Protolude++import Data.Field.Galois as F hiding (recip)+import Data.Group+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck++annihilation :: Eq a => (a -> a -> a) -> a -> a -> Bool+annihilation op e x = op x e == e && op e x == e++associativity :: Eq a => (a -> a -> a) -> a -> a -> a -> Bool+associativity op x y z = op x (op y z) == op (op x y) z++commutativity :: Eq a => (a -> a -> a) -> a -> a -> Bool+commutativity op x y = op x y == op y x++distributivity :: Eq a => (a -> a -> a) -> (a -> a -> a) -> a -> a -> a -> Bool+distributivity op op' x y z = op (op' x y) z == op' (op x z) (op y z)+ && op x (op' y z) == op' (op x y) (op x z)++identities :: Eq a => (a -> a -> a) -> a -> a -> Bool+identities op e x = op x e == x && op e x == x++inverses :: Eq a => (a -> a -> a) -> (a -> a) -> a -> a -> Bool+inverses op inv e x = op x (inv x) == e && op (inv x) x == e++groupAxioms :: forall g . (Arbitrary g, Eq g, Show g)+ => (g -> g -> g) -> (g -> g) -> g -> (g -> Bool) -> [TestTree]+groupAxioms add inv id cond =+ [ testProperty "associativity" $+ associativity add+ , testProperty "commutativity" $+ commutativity add+ , testProperty "identity" $+ identities add id+ , testProperty "inverses" $+ \x -> cond x ==> inverses add inv id x+ ]++fieldAxioms :: forall k . GaloisField k => k -> TestTree+fieldAxioms _ = testGroup "Field axioms"+ [ testGroup "additive group axioms" $+ groupAxioms (+) negate (0 :: k) (const True)+ , testGroup "multiplicative group axioms" $+ groupAxioms (*) recip (1 :: k) (/= 0)+ , testProperty "distributivity of multiplication over addition" $+ distributivity ((*) :: k -> k -> k) (+)+ , testProperty "multiplicative annihilation" $+ annihilation ((*) :: k -> k -> k) 0+ ]++frobeniusEndomorphisms :: forall k . GaloisField k => k -> TestTree+frobeniusEndomorphisms _ = localOption (QuickCheckTests 10) $ testGroup "Frobenius endomorphisms"+ [ testProperty "frobenius endomorphisms are characteristic powers" $+ \(x :: k) -> frob x == F.pow x (char (witness :: k))+ , testProperty "frobenius endomorphisms are ring homomorphisms" $+ \(x :: k) (y :: k) (z :: k) -> frob (x * y + z) == frob x * frob y + frob z+ ]++testField :: forall k . GaloisField k => TestName -> k -> TestTree+testField s x = testGroup s [fieldAxioms x, frobeniusEndomorphisms x]++testUnity :: forall n k . (KnownNat n, GaloisField k, CyclicSubgroup (RootsOfUnity n k))+ => TestName -> RootsOfUnity n k -> TestTree+testUnity s g = testGroup s+ [ localOption (QuickCheckTests 10) . testGroup "Group axioms" $+ groupAxioms (<>) invert (mempty :: RootsOfUnity n k) (const True)+ , testCase "roots of unity" $+ isRootOfUnity g @?= True+ ]
+ test/Test/Pairing.hs view
@@ -0,0 +1,42 @@+module Test.Pairing where++import Protolude++import Data.Curve.Weierstrass+import Data.Group+import Data.Pairing.Hash+import Test.QuickCheck.Instances ()+import Test.QuickCheck.Monadic+import Test.Tasty+import Test.Tasty.QuickCheck++bilinearity :: (Eq c, Group a, Group b, Group c)+ => (a -> b -> c) -> Word -> a -> b -> Bool+bilinearity pair n x y = pair (pow x n) y == pow (pair x y) n+ && pair x (pow y n) == pow (pair x y) n++nondegeneracy :: (Eq a, Eq b, Eq c, Group a, Group b, Group c)+ => (a -> b -> c) -> a -> b -> Bool+nondegeneracy pair x y = x == mempty || y == mempty || pair x y /= mempty++testPairing :: forall e . Pairing e => e -> TestTree+testPairing _ = localOption (QuickCheckTests 10) $ testGroup "Pairing axioms"+ [ testProperty "bilinearity" $+ bilinearity (pairing :: G1 e -> G2 e -> GT e)+ , testProperty "nondegeneracy" $+ nondegeneracy (pairing :: G1 e -> G2 e -> GT e)+ ]++testHashBN :: forall e q r u v w . ECPairing e q r u v w => e -> TestTree+testHashBN _ = testProperty "Encoding well-defined" $ \bs -> monadicIO $ do+ curve :: Maybe (G1 e) <- run $ swEncBN bs+ assert $ isJust curve+ let curve' = fromMaybe (panic "unreachable.") curve+ assert $ def curve'++testHashBLS12 :: forall e q r u v w . ECPairing e q r u v w => e -> TestTree+testHashBLS12 _ = testProperty "Encoding well-defined" $ \bs -> monadicIO $ do+ curve :: Maybe (G1 e) <- run $ swEncBLS12 bs+ assert $ isJust curve+ let curve' = fromMaybe (panic "unreachable.") curve+ assert $ def curve'
− tests/ByteTests.hs
@@ -1,61 +0,0 @@-module ByteTests where--import Protolude--import ExtensionField-import GaloisField-import Pairing.ByteRepr-import Pairing.Curve-import PrimeField-import Test.QuickCheck.Monadic-import Test.Tasty-import Test.Tasty.HUnit-import Test.Tasty.QuickCheck--testByte :: TestTree-testByte = testGroup "Byte"- [ testProperty "Fq" prop_fqByteRepr- , testProperty "Fq2" prop_fq2ByteRepr- , testProperty "Fq6" prop_fq6ByteRepr- , testProperty "Fq12" prop_fq12ByteRepr- ]--byteReprTest :: (ByteRepr k, GaloisField k)- => k -> Pairing.ByteRepr.ByteOrder -> Int -> Assertion-byteReprTest f bo sz = do - let t = mkRepr (ByteOrderLength bo sz) f- assertBool ("mkRepr " <> show f) (isJust t)- let bs = fromMaybe (panic "unreachable.") t- let d = fromRepr (ByteOrderLength bo sz) f bs- assertBool ("fromRepr " <> show f) (isJust d)- d @?= Just f--primeFieldTest :: (ByteRepr (PrimeField p), KnownNat p)- => PrimeField p -> Assertion-primeFieldTest f = do- byteReprTest f MostSignificantFirst 32- byteReprTest f LeastSignificantFirst 32- byteReprTest f MostSignificantFirst 64- byteReprTest f LeastSignificantFirst 64--extensionFieldTest :: (ByteRepr (ExtensionField k im), IrreducibleMonic k im)- => ExtensionField k im -> Assertion-extensionFieldTest f = case fromField f of- [] -> pure ()- _ -> do- byteReprTest f MostSignificantFirst 32- byteReprTest f LeastSignificantFirst 32- byteReprTest f MostSignificantFirst 64- byteReprTest f LeastSignificantFirst 64--prop_fqByteRepr :: Fq -> Property-prop_fqByteRepr = monadicIO . run . primeFieldTest--prop_fq2ByteRepr :: Fq2 -> Property-prop_fq2ByteRepr = monadicIO . run . extensionFieldTest--prop_fq6ByteRepr :: Fq6 -> Property-prop_fq6ByteRepr = monadicIO . run . extensionFieldTest--prop_fq12ByteRepr :: Fq12 -> Property-prop_fq12ByteRepr = monadicIO . run . extensionFieldTest
− tests/HashTests.hs
@@ -1,22 +0,0 @@-module HashTests where--import Protolude--import Curve-import Pairing.Hash-import Test.QuickCheck.Instances ()-import Test.QuickCheck.Monadic-import Test.Tasty-import Test.Tasty.QuickCheck--testHash :: TestTree-testHash = testGroup "Hash"- [ testProperty "swEncBN" prop_swEncBN- ]--prop_swEncBN :: ByteString -> Property-prop_swEncBN bs = monadicIO $ do- toCurveMay <- run $ swEncBN bs- assert $ isJust toCurveMay- let toCurve = fromMaybe (panic "unreachable.") toCurveMay- assert $ def toCurve
− tests/Main.hs
@@ -1,14 +0,0 @@-module Main where--import Protolude--import Test.Tasty--import ByteTests-import HashTests-import PairingTests-import SerializeTests--main :: IO ()-main = defaultMain $- testGroup "Pairing" [testByte, testHash, testPairing, testSerialize]
− tests/PairingTests.hs
@@ -1,147 +0,0 @@-module PairingTests where--import Protolude--import Curve.Weierstrass-import ExtensionField-import Group.Field-import Pairing.Curve-import Pairing.Pairing-import Test.Tasty-import Test.Tasty.HUnit-import Test.Tasty.QuickCheck--testPairing :: TestTree-testPairing = testGroup "Pairing"- [ testCase "input G1 valid" unit_inpG1_valid- , testCase "input G2 valid" unit_inpG2_valid- , testCase "pairing libff 0" unit_pairingLibff_0- , testCase "pairing libff 1" unit_pairingLibff_1- , testProperty "pairing bilinear" prop_pairingBilinear- , testProperty "pairing non degenerate" prop_pairingNonDegenerate- , testProperty "pairing power test" prop_pairingPowerTest- , testProperty "correct Frobenius Fq12" prop_frobeniusFq12Correct- , testProperty "correct final exponentiation" prop_finalExponentiationCorrect- ]---- Random points in G1, G2 as generated by libff.-inpG1 :: G1-inpG1 = A- 1368015179489954701390400359078579693043519447331113978918064868415326638035- 9918110051302171585080402603319702774565515993150576347155970296011118125764--inpG2 :: G2-inpG2 = A- ( toField [ 2725019753478801796453339367788033689375851816420509565303521482350756874229- , 7273165102799931111715871471550377909735733521218303035754523677688038059653- ]- )- ( toField [ 2512659008974376214222774206987427162027254181373325676825515531566330959255- , 957874124722006818841961785324909313781880061366718538693995380805373202866- ]- )--beforeExponentiation :: GT-beforeExponentiation = F $- toField [ toField [ toField [ 10244919957345566208036224388367387294947954375520342002142038721148536068658- , 20520725903107462730350108147804326707908059028221039276493719519842949720531- ]- , toField [ 6086095302240468555411758663466251351417777262748587710512082696159022563215- , 3498483043828007000664704983384438380014626741459095899124517210966193962189- ]- , toField [ 9839947403899670326057934148290729066991318244952536153418081752510541932805- , 9202072764973620760720243946210007480782851719144203914690329192926361472509- ]- ]- , toField [ toField [ 10396963991176748371570893144856868074352236348257264320828640725417622807401- , 16918234646064442383576265933863121396979541666923405352165222603555475148795- ]- , toField [ 1146287855099517708899800840204495527878843746533321795244252048321172986641- , 15272723827732170058231690870045992172379497733734277515700990114389642596090- ]- , toField [ 6026541190208646112995382377707652888403252171847993766999540977939986078453- , 4033750506662808934164561353819561401109395743946249795674228367029912558059- ]- ]- ]--afterExponentiation :: GT-afterExponentiation = F $- toField [ toField [ toField [ 7297928317524675251652102644847406639091474940444702627333408876432772026640- , 18010865284024443253481973710158529446817119443459787454101328040744995455319- ]- , toField [ 14179125828660221708486990054318233868908974550229474018509093903907472063156- , 19672547343219696395323430329000470270122259521813831378125910505067755316037- ]- , toField [ 10811020225621941034352015694422164943041584464746963243431262955968538467312- , 18591344525433923700278298641693487837785792806011751060570085671866249379154- ]- ]- , toField [ toField [ 18214296718386486500838507024306049626571830525675768493345345883297201451077- , 19227311731387426597265504864999881769743583647552324796732605660514141916117- ]- , toField [ 15463354980731838106439887363063618463783317416732018231077874458188347926701- , 3765441250413579779915094051038487360437654739171671492016287185303087270469- ]- , toField [ 21029416079740174485345021549306749850075185576152640151652655104272393297142- , 19736982780723093346009254617143639137054958583796054069884522103959451721163- ]- ]- ]---- Sanity check test inputs-unit_inpG1_valid :: Assertion-unit_inpG1_valid- = assertBool "inpG1 does not satisfy curve equation" $ def inpG1--unit_inpG2_valid :: Assertion-unit_inpG2_valid- = assertBool "inpG2 does not satisfy curve equation" $ def inpG2---- Test our pairing ouput against that of libff.-unit_pairingLibff_0 :: Assertion-unit_pairingLibff_0 = beforeExponentiation @=? atePairing inpG1 inpG2--unit_pairingLibff_1 :: Assertion-unit_pairingLibff_1 = afterExponentiation @=? reducedPairing inpG1 inpG2--pairingTestCount :: Int-pairingTestCount = 10--prop_pairingBilinear :: Property-prop_pairingBilinear = withMaxSuccess pairingTestCount prop- where- prop :: G1 -> G2 -> Integer -> Integer -> Bool- prop e1 e2 preExp1 preExp2- = reducedPairing (mul' e1 exp1) (mul' e2 exp2)- == mul' (reducedPairing e1 e2) (exp1 * exp2)- where- -- Quickcheck might give us negative integers or 0, so we- -- take the absolute values instead and add one.- exp1 = abs preExp1 + 1- exp2 = abs preExp2 + 1--prop_pairingNonDegenerate :: Property-prop_pairingNonDegenerate = withMaxSuccess pairingTestCount prop- where- prop :: G1 -> G2 -> Bool- prop e1 e2 = or [ e1 == mempty- , e2 == mempty- , reducedPairing e1 e2 /= mempty- ]---- Output of the pairing to the power _r should be the unit of GT.-prop_pairingPowerTest :: Property-prop_pairingPowerTest = withMaxSuccess pairingTestCount prop- where- prop :: G1 -> G2 -> Bool- prop e1 e2 = def (reducedPairing e1 e2)--prop_frobeniusFq12Correct :: Fq12 -> Bool-prop_frobeniusFq12Correct f = frobeniusNaive 1 f == fq12Frobenius 1 f--prop_finalExponentiationCorrect :: Property-prop_finalExponentiationCorrect = withMaxSuccess pairingTestCount prop- where- prop :: Fq12 -> Bool- prop f = finalExponentiation f == finalExponentiationNaive f
− tests/SerializeTests.hs
@@ -1,61 +0,0 @@-module SerializeTests where--import Test.Tasty--testSerialize :: TestTree-testSerialize = testGroup "Serialize"- [- ]---- serializeTest pt compFunc testFunc = do--- let (Just cbs) = compFunc pt--- let npt2e = testFunc cbs--- isRight npt2e @? (Protolude.show npt2e)--- let (Right npt2) = npt2e--- pt @=? npt2--- --- serializeUncompProp :: (Ord b, Show b, MkUncompressedForm a, ByteRepr b, FromX b) => (a -> LByteString -> Either Text (Point b)) -> a -> Point b -> Property--- serializeUncompProp f a g = TQM.monadicIO $ TQM.run $ serializeTest g (serializePointUncompressed a) (f a)--- --- serializeCompProp :: (Ord b, Show b, MkCompressedForm a, ByteRepr b, FromX b) => (a -> LByteString -> Either Text (Point b)) -> a -> Point b -> Property--- serializeCompProp f a g = TQM.monadicIO $ TQM.run $ serializeTest g (serializeCompressed a) (f a)--- --- unit_g1SerializeCompMCLWasm :: Assertion--- unit_g1SerializeCompMCLWasm = do--- let g1pt = Point (9314493114755198232379544958894901330290171903936264295471737527783061073337 :: Fq) (3727704492399430267836652969370123320076852948746739702603703543134592597527 :: Fq)--- let hs = hexString "b92db2fcfcba5ad9f6b676de13a5488b54dfd537ae5c96291f399284f7d09794"--- let Right np = unserializePoint MCLWASM g1 (toSL $ H.toBytes hs)--- np @=? g1pt--- --- prop_g1SerializeUncompJivsov :: G1 -> Property--- prop_g1SerializeUncompJivsov g = serializeUncompProp fromByteStringG1 Jivsov g--- --- prop_g1SerializeCompJivsov :: G1 -> Property--- prop_g1SerializeCompJivsov g = serializeCompProp fromByteStringG1 Jivsov g--- --- prop_g1SerializeCompMCLWasm :: G1 -> Property--- prop_g1SerializeCompMCLWasm g = serializeCompProp fromByteStringG1 MCLWASM g--- --- unit_g2SerializeCompMCLWasm :: Assertion--- unit_g2SerializeCompMCLWasm = do--- let fq2x = toField ([6544947162799133903546594463061476713923884516504213524167597810128866380952, 1440920261338086273401746857890494196693993714596389710801111883382590011446] :: [Fq]) :: Fq2--- let fq2y = toField ([7927561822697823059695659663409507948904771679743888257723485312240532833493, 2189896469972867352153851473169755334250894385106289486234761879693772655721] :: [Fq]) :: Fq2--- let g2pt = Point fq2x fq2y--- let hs = hexString "980cf2acdb1645247a512f91cbbbbb1f4fa2328c979ae26d550ec7b80e4f780e36f82f7090c4d516a2257fcee804df8421af857b2f80ffccfc11c6f52e882f83"--- let Right np = unserializePoint MCLWASM g2 (toSL $ H.toBytes hs)--- np @=? g2pt--- --- prop_g2SerializeUncompJivsov :: G2 -> Property--- prop_g2SerializeUncompJivsov g = serializeUncompProp fromByteStringG2 Jivsov g--- --- prop_g2SerializeCompJivsov :: G2 -> Property--- prop_g2SerializeCompJivsov g = serializeCompProp fromByteStringG2 Jivsov g--- --- prop_g2SerializeCompMCLWasm :: G2 -> Property--- prop_g2SerializeCompMCLWasm g = serializeCompProp fromByteStringG2 MCLWASM g--- --- gtSerializeTest :: G1 -> G2 -> Assertion--- gtSerializeTest g1 g2 = serializeTest (reducedPairing g1 g2) (serializeUncompressed Jivsov) (fromByteStringGT Jivsov)--- --- prop_gtSerializeUncomp :: G1 -> G2 -> Property--- prop_gtSerializeUncomp g1 g2 = TQM.monadicIO $ TQM.run $ gtSerializeTest g1 g2