diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,18 @@ # Changelog for pairing +## 0.4.1 + +* Add mclwasm compatible serialisation +* Add efficient storage representation of an elliptic curve point over prime fields + +## 0.4 + +* Use `galois-field` for tower field underlying BN128 curve. + +## 0.3.1 + +* Use `MonadRandom` typeclass constraints for curve hashing functions. + ## 0.3 - Square root calculation on Fq2 @@ -7,6 +20,8 @@ - Point serialisation for G1, G2 and GT ## 0.2 + +* Adds Shallue van de Woestijne encoding for curve hashing. ## 0.1 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,5 +1,7 @@

- + + Adjoint Logo +

[![CircleCI](https://circleci.com/gh/adjoint-io/pairing.svg?style=svg&circle-token=ac95d02ba07e02b88585397f91cfe92a8c833343)](https://circleci.com/gh/adjoint-io/pairing) diff --git a/bench/BenchPairing.hs b/bench/BenchPairing.hs --- a/bench/BenchPairing.hs +++ b/bench/BenchPairing.hs @@ -1,73 +1,71 @@ -{-# LANGUAGE NoImplicitPrelude #-} - module BenchPairing (benchmarks) where import Protolude import Criterion.Main -import qualified Pairing.Group as Group -import qualified Pairing.Point as Point -import qualified Pairing.Pairing as Pairing +import ExtensionField +import GaloisField import Pairing.CyclicGroup (asInteger) import qualified Pairing.Fq as Fq import qualified Pairing.Fr as Fr -import qualified Pairing.Fq2 as Fq2 -import qualified Pairing.Fq6 as Fq6 -import qualified Pairing.Fq12 as Fq12 -import Pairing.Fq12 (Fq12(..), new, fq12frobenius) +import qualified Pairing.Group as Group +import qualified Pairing.Pairing as Pairing +import qualified Pairing.Point as Point ------------------------------------------------------------------------------- -- Benchmark Suite ------------------------------------------------------------------------------- testFq_1:: Fq.Fq -testFq_1 = Fq.new 5216004179354450092383934373463611881445186046129513844852096383579774061693 +testFq_1 = 5216004179354450092383934373463611881445186046129513844852096383579774061693 testFq_2 :: Fq.Fq -testFq_2 = Fq.new 10757805228921058098980668000791497318123219899766237205512608761387909753942 +testFq_2 = 10757805228921058098980668000791497318123219899766237205512608761387909753942 testFr_1 :: Fr.Fr -testFr_1 = Fr.new 2695867032484221784304381330654541950835516252740416091986521990446187260192 +testFr_1 = 2695867032484221784304381330654541950835516252740416091986521990446187260192 testFr_2 :: Fr.Fr -testFr_2 = Fr.new 18361718052247311177607809961708721447660708684581683997732416822928487385039 +testFr_2 = 18361718052247311177607809961708721447660708684581683997732416822928487385039 -testFq2_1 :: Fq2.Fq2 -testFq2_1 = Fq2.new - 19908898611787582971615951530393785823319364696376311494770162270472288380562 - 2444690988583914246674870181013910409542697083717824402984851238236041783759 +testFq2_1 :: Fq.Fq2 +testFq2_1 = fromList + [ 19908898611787582971615951530393785823319364696376311494770162270472288380562 + , 2444690988583914246674870181013910409542697083717824402984851238236041783759 ] -testFq2_2 :: Fq2.Fq2 -testFq2_2 = Fq2.new - 176307305890807650390915550856467756101144733976249050387177647283239486934 - 9913547941088878400547309488585076816688958962210000330808066250849942240036 +testFq2_2 :: Fq.Fq2 +testFq2_2 = fromList + [ 176307305890807650390915550856467756101144733976249050387177647283239486934 + , 9913547941088878400547309488585076816688958962210000330808066250849942240036 ] -testFq6_1 :: Fq6.Fq6 -testFq6_1 = Fq6.new - (Fq2.new - 8727269669017421992537561450387212506711577304101544328736696625792447584819 - 14548604791762199086915107662335514800873255588931510951007415299299859294564) - (Fq2.new - 12226353852518517213098257637254082040554292743096797524265221809863992104040 - 12690801089710533803594523982915673248220237967492611523932652691226365708512) - (Fq2.new - 18336930404004840796680535059992401039831316705513753839479258873269709495858 - 21634580953983557175729336703450663797341055784728343534694506874757389871868) +testFq6_1 :: Fq.Fq6 +testFq6_1 = fromList + [ fromList + [ 8727269669017421992537561450387212506711577304101544328736696625792447584819 + , 14548604791762199086915107662335514800873255588931510951007415299299859294564 ] + , fromList + [ 12226353852518517213098257637254082040554292743096797524265221809863992104040 + , 12690801089710533803594523982915673248220237967492611523932652691226365708512 ] + , fromList + [ 18336930404004840796680535059992401039831316705513753839479258873269709495858 + , 21634580953983557175729336703450663797341055784728343534694506874757389871868 ] + ] -testFq6_2 :: Fq6.Fq6 -testFq6_2 = Fq6.new - (Fq2.new - 21427158918811764040959407626476119248515601360702754918240300689672054041331 - 12750457256357562507331331307761996193149796736574153338180573114576232473092) - (Fq2.new - 19307896751125425658868292427117755307914453765471505616446813557567103424424 - 11511704315039881938763578963465960361806962511008317843374696569679546862720) - (Fq2.new - 16856354813335682789816416666746807604324955216244680818919639213184967817815 - 10563739714379631354612735346769824530666877338817980746884577737330686430079) +testFq6_2 :: Fq.Fq6 +testFq6_2 = fromList + [ fromList + [ 21427158918811764040959407626476119248515601360702754918240300689672054041331 + , 12750457256357562507331331307761996193149796736574153338180573114576232473092 ] + , fromList + [ 19307896751125425658868292427117755307914453765471505616446813557567103424424 + , 11511704315039881938763578963465960361806962511008317843374696569679546862720 ] + , fromList + [ 16856354813335682789816416666746807604324955216244680818919639213184967817815 + , 10563739714379631354612735346769824530666877338817980746884577737330686430079 ] + ] -testFq12_1 :: Fq12.Fq12 -testFq12_1 = Fq12.new +testFq12_1 :: Fq.Fq12 +testFq12_1 = Fq.construct [ 4025484419428246835913352650763180341703148406593523188761836807196412398582 , 5087667423921547416057913184603782240965080921431854177822601074227980319916 , 8868355606921194740459469119392835913522089996670570126495590065213716724895 @@ -82,8 +80,8 @@ , 1205855382909824928004884982625565310515751070464736233368671939944606335817 ] -testFq12_2 :: Fq12.Fq12 -testFq12_2 = Fq12.new +testFq12_2 :: Fq.Fq12 +testFq12_2 = Fq.construct [ 495492586688946756331205475947141303903957329539236899715542920513774223311 , 9283314577619389303419433707421707208215462819919253486023883680690371740600 , 11142072730721162663710262820927009044232748085260948776285443777221023820448 @@ -110,147 +108,141 @@ test_g2_1 :: Group.G2 test_g2_1 = Point.Point - (Fq2.new - 7883069657575422103991939149663123175414599384626279795595310520790051448551 - 8346649071297262948544714173736482699128410021416543801035997871711276407441) - (Fq2.new - 3343323372806643151863786479815504460125163176086666838570580800830972412274 - 16795962876692295166012804782785252840345796645199573986777498170046508450267) + (fromList + [ 7883069657575422103991939149663123175414599384626279795595310520790051448551 + , 8346649071297262948544714173736482699128410021416543801035997871711276407441 ] + ) + (fromList + [ 3343323372806643151863786479815504460125163176086666838570580800830972412274 + , 16795962876692295166012804782785252840345796645199573986777498170046508450267 ] + ) test_g2_2 :: Group.G2 test_g2_2 = Point.Point - (Fq2.new - 3243608945627071355385114622932133122087974401138668305336804137033580208808 - 2403320200938270623472619242963887735471304641554649101656774729615146397552) - (Fq2.new - 7590136428571280465598215063146990078553196689176860926896020586846726844869 - 8036135660414384292776446470327730948618639044617118659780848199544099832559) + (fromList + [ 3243608945627071355385114622932133122087974401138668305336804137033580208808 + , 2403320200938270623472619242963887735471304641554649101656774729615146397552 ] + ) + (fromList + [ 7590136428571280465598215063146990078553196689176860926896020586846726844869 + , 8036135660414384292776446470327730948618639044617118659780848199544099832559 ] + ) test_hash :: ByteString -test_hash = toS "TyqIPUBYojDVOnDPacfMGrGOzpaQDWD3KZCpqzLhpE4A3kRUCQFUx040Ok139J8WDVV2C99Sfge3G20Q8MEgu23giWmqRxqOc8pH" +test_hash = "TyqIPUBYojDVOnDPacfMGrGOzpaQDWD3KZCpqzLhpE4A3kRUCQFUx040Ok139J8WDVV2C99Sfge3G20Q8MEgu23giWmqRxqOc8pH" benchmarks :: [Benchmark] -benchmarks - = [ bgroup "Frobenius in Fq12" - [ bench "naive" - $ whnf (Pairing.frobeniusNaive 1) testFq12_1 - , bench "fast" - $ whnf (fq12frobenius 1) testFq12_1 - ] - - , bgroup "Final exponentiation" - [ bench "naive" - $ whnf Pairing.finalExponentiationNaive testFq12_1 - , bench "fast" - $ whnf Pairing.finalExponentiation testFq12_1 - ] - - , bgroup "Pairing" - [ bench "without final exponentiation" - $ whnf (uncurry Pairing.atePairing) (Group.g1, Group.g2) - , bench "with final exponentiation" - $ whnf (uncurry Pairing.reducedPairing) (Group.g1, Group.g2) - ] - - , bgroup "Fq" - [ bench "multiplication" - $ whnf (uncurry (*)) (testFq_1, testFq_2) - , bench "addition" - $ whnf (uncurry (+)) (testFq_1, testFq_2) - , bench "division" - $ whnf (uncurry (/)) (testFq_1, testFq_2) - , bench "pow" - $ whnf (Fq.fqPow testFq_1) (asInteger testFr_1) - , bench "inversion" - $ whnf Fq.fqInv testFq_1 - , bench "fqFromX" - $ whnf (Fq.fqYforX testFq_1) True - ] - - , bgroup "Fr" - [ bench "multiplication" - $ whnf (uncurry (*)) (testFr_1, testFr_2) - , bench "addition" - $ whnf (uncurry (+)) (testFr_1, testFr_2) - , bench "division" - $ whnf (uncurry (/)) (testFr_1, testFr_2) - , bench "inversion" - $ whnf Fr.frInv testFr_1 - , bench "pow" - $ whnf (Fr.frPow testFr_1) (asInteger testFr_2) - ] - - , bgroup "Fq2" - [ bench "multiplication" - $ whnf (uncurry (*)) (testFq2_1, testFq2_2) - , bench "addition" - $ whnf (uncurry (+)) (testFq2_1, testFq2_2) - , bench "division" - $ whnf (uncurry (/)) (testFq2_1, testFq2_2) - , bench "squaring" - $ whnf Fq2.fq2sqr testFq2_1 - , bench "pow" - $ whnf (Fq2.fq2pow testFq2_1) (asInteger testFr_1) - , bench "negation" - $ whnf negate testFq2_1 - , bench "inversion" - $ whnf Fq2.fq2inv testFq2_1 - , bench "conjugation" - $ whnf Fq2.fq2conj testFq2_1 - , bench "square root" - $ whnf Fq2.fq2sqrt testFq2_1 - , bench "fq2FromX" - $ whnf (Fq2.fq2YforX testFq2_1) True - ] - - , bgroup "Fq6" - [ bench "multiplication" - $ whnf (uncurry (*)) (testFq6_1, testFq6_2) - , bench "addition" - $ whnf (uncurry (+)) (testFq6_1, testFq6_2) - , bench "division" - $ whnf (uncurry (/)) (testFq6_1, testFq6_2) - , bench "squaring" - $ whnf Fq6.fq6sqr testFq6_1 - , bench "negation" - $ whnf negate testFq6_1 - , bench "inversion" - $ whnf Fq6.fq6inv testFq6_1 - ] - - , bgroup "Fq12" - [ bench "multiplication" - $ whnf (uncurry (*)) (testFq12_1, testFq12_2) - , bench "addition" - $ whnf (uncurry (+)) (testFq12_1, testFq12_2) - , bench "division" - $ whnf (uncurry (/)) (testFq12_1, testFq12_2) - , bench "negation" - $ whnf negate testFq12_1 - , bench "inversion" - $ whnf Fq12.fq12inv testFq12_1 - , bench "conjugation" - $ whnf Fq12.fq12conj testFq12_1 - ] - - , bgroup "G1" - [ bench "double" - $ whnf Point.gDouble test_g1_1 - , bench "add" - $ whnf (uncurry Point.gAdd) (test_g1_1, test_g1_2) - , bench "multiply" - $ whnf (uncurry Point.gMul) (test_g1_1, 42) - , bench "hashToG1" - $ whnfIO (Group.hashToG1 test_hash) - ] - - , bgroup "G2" - [ bench "double" - $ whnf Point.gDouble test_g2_1 - , bench "add" - $ whnf (uncurry Point.gAdd) (test_g2_1, test_g2_2) - , bench "multiply" - $ whnf (uncurry Point.gMul) (test_g2_1, 42) - ] - - ] +benchmarks = + [ bgroup "Frobenius in Fq12" + [ bench "naive" + $ whnf (Pairing.frobeniusNaive 1) testFq12_1 + , bench "fast" + $ whnf (Fq.fq12Frobenius 1) testFq12_1 + ] + , bgroup "Final exponentiation" + [ bench "naive" + $ whnf Pairing.finalExponentiationNaive testFq12_1 + , bench "fast" + $ whnf Pairing.finalExponentiation testFq12_1 + ] + , bgroup "Pairing" + [ bench "without final exponentiation" + $ whnf (uncurry Pairing.atePairing) (Group.g1, Group.g2) + , bench "with final exponentiation" + $ whnf (uncurry Pairing.reducedPairing) (Group.g1, Group.g2) + ] + , bgroup "Fq" + [ bench "multiplication" + $ whnf (uncurry (*)) (testFq_1, testFq_2) + , bench "addition" + $ whnf (uncurry (+)) (testFq_1, testFq_2) + , bench "division" + $ whnf (uncurry (/)) (testFq_1, testFq_2) + , bench "pow" + $ whnf (testFq_1 `pow`) (asInteger testFr_1) + , bench "inversion" + $ whnf recip testFq_1 + , bench "fqFromX" + $ whnf (Fq.fqYforX testFq_1) max + ] + , bgroup "Fr" + [ bench "multiplication" + $ whnf (uncurry (*)) (testFr_1, testFr_2) + , bench "addition" + $ whnf (uncurry (+)) (testFr_1, testFr_2) + , bench "division" + $ whnf (uncurry (/)) (testFr_1, testFr_2) + , bench "inversion" + $ whnf recip testFr_1 + , bench "pow" + $ whnf (testFr_1 ^) (asInteger testFr_2) + ] + , bgroup "Fq2" + [ bench "multiplication" + $ whnf (uncurry (*)) (testFq2_1, testFq2_2) + , bench "addition" + $ whnf (uncurry (+)) (testFq2_1, testFq2_2) + , bench "division" + $ whnf (uncurry (/)) (testFq2_1, testFq2_2) + , bench "squaring" + $ whnf (^ 2) testFq2_1 + , bench "pow" + $ whnf (testFq2_1 `pow`) (asInteger testFr_1) + , bench "negation" + $ whnf negate testFq2_1 + , bench "inversion" + $ whnf recip testFq2_1 + , bench "conjugation" + $ whnf Fq.fq2Conj testFq2_1 + , bench "square root" + $ whnf Fq.fq2Sqrt testFq2_1 + , bench "fq2FromX" + $ whnf (Fq.fq2YforX testFq2_1) max + ] + , bgroup "Fq6" + [ bench "multiplication" + $ whnf (uncurry (*)) (testFq6_1, testFq6_2) + , bench "addition" + $ whnf (uncurry (+)) (testFq6_1, testFq6_2) + , bench "division" + $ whnf (uncurry (/)) (testFq6_1, testFq6_2) + , bench "squaring" + $ whnf (^ 2) testFq6_1 + , bench "negation" + $ whnf negate testFq6_1 + , bench "inversion" + $ whnf recip testFq6_1 + ] + , bgroup "Fq12" + [ bench "multiplication" + $ whnf (uncurry (*)) (testFq12_1, testFq12_2) + , bench "addition" + $ whnf (uncurry (+)) (testFq12_1, testFq12_2) + , bench "division" + $ whnf (uncurry (/)) (testFq12_1, testFq12_2) + , bench "negation" + $ whnf negate testFq12_1 + , bench "inversion" + $ whnf recip testFq12_1 + , bench "conjugation" + $ whnf Fq.fq12Conj testFq12_1 + ] + , bgroup "G1" + [ bench "double" + $ whnf Point.gDouble test_g1_1 + , bench "add" + $ whnf (uncurry Point.gAdd) (test_g1_1, test_g1_2) + , bench "multiply" + $ whnf (uncurry Point.gMul) (test_g1_1, 42) + , bench "hashToG1" + $ whnfIO (Group.hashToG1 test_hash) + ] + , bgroup "G2" + [ bench "double" + $ whnf Point.gDouble test_g2_1 + , bench "add" + $ whnf (uncurry Point.gAdd) (test_g2_1, test_g2_2) + , bench "multiply" + $ whnf (uncurry Point.gMul) (test_g2_1, 42) + ] + ] diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude #-} - -- To get the benchmarking data, run "stack bench". module Main where diff --git a/pairing.cabal b/pairing.cabal --- a/pairing.cabal +++ b/pairing.cabal @@ -2,12 +2,12 @@ -- -- see: https://github.com/sol/hpack -- --- hash: c54816acbfcbae987dfabc18793935f2ee26262bbaf23e1efad1ae5f22512cb0 +-- hash: 80d5b7b460cd15c793b86c61d342bfb609e71fb776fcd8c1d7532aaf6e978334 name: pairing -version: 0.3.1 -synopsis: Optimal ate pairing over Barreto-Naehrig curves -description: Optimal ate pairing over Barreto-Naehrig curves +version: 0.4.1 +synopsis: Bilinear pairings +description: Optimal Ate pairing over Barreto-Naehrig curves category: Cryptography homepage: https://github.com/adjoint-io/pairing#readme bug-reports: https://github.com/adjoint-io/pairing/issues @@ -24,46 +24,37 @@ type: git location: https://github.com/adjoint-io/pairing -flag optimized - description: Perform compiler optimizations - manual: False - default: False - -flag static - description: Emit statically-linked binary - manual: False - default: False - library exposed-modules: Pairing.Params Pairing.Fq Pairing.Fr - Pairing.Fq2 - Pairing.Fq6 - Pairing.Fq12 Pairing.Point Pairing.Group Pairing.Pairing Pairing.Jacobian Pairing.CyclicGroup Pairing.Hash - Pairing.Serialize + Pairing.Serialize.Types + Pairing.Serialize.Jivsov + Pairing.Serialize.MCLWasm Pairing.ByteRepr - other-modules: Pairing.Modular + other-modules: + Paths_pairing hs-source-dirs: src - default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances ExplicitForAll RankNTypes DataKinds KindSignatures GeneralizedNewtypeDeriving TypeApplications ExistentialQuantification ScopedTypeVariables DeriveGeneric BangPatterns FlexibleContexts - ghc-options: -fwarn-tabs -fwarn-incomplete-patterns -fwarn-incomplete-record-updates -fwarn-redundant-constraints -fwarn-implicit-prelude -fwarn-overflowed-literals -fwarn-orphans -fwarn-identities -fwarn-dodgy-exports -fwarn-dodgy-imports -fwarn-duplicate-exports -fwarn-overlapping-patterns -fwarn-missing-fields -fwarn-missing-methods -fwarn-missing-signatures -fwarn-noncanonical-monad-instances -fwarn-unused-pattern-binds -fwarn-unused-type-patterns -fwarn-unrecognised-pragmas -fwarn-wrong-do-bind -fno-warn-name-shadowing -fno-warn-unused-binds -fno-warn-unused-matches -fno-warn-unused-do-bind + default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances FlexibleContexts ScopedTypeVariables RankNTypes BangPatterns DataKinds DeriveAnyClass DeriveFunctor DeriveGeneric GeneralizedNewtypeDeriving MultiParamTypeClasses TypeApplications + ghc-options: -fwarn-tabs -fwarn-incomplete-patterns -fwarn-incomplete-record-updates -fwarn-redundant-constraints -fwarn-implicit-prelude -fwarn-overflowed-literals -fwarn-orphans -fwarn-identities -fwarn-dodgy-exports -fwarn-dodgy-imports -fwarn-duplicate-exports -fwarn-overlapping-patterns -fwarn-missing-fields -fwarn-missing-methods -fwarn-missing-signatures -fwarn-noncanonical-monad-instances -fwarn-unused-pattern-binds -fwarn-unused-type-patterns -fwarn-unrecognised-pragmas -fwarn-wrong-do-bind -fno-warn-name-shadowing -fno-warn-unused-binds -fno-warn-unused-matches -fno-warn-unused-do-bind -Wmissing-export-lists build-depends: - QuickCheck - , arithmoi + MonadRandom + , QuickCheck + , arithmoi >=0.8 , base >=4.7 && <5 , binary , bytestring - , cryptonite , errors + , galois-field >=0.2 , integer-logarithms , memory , protolude >=0.2 @@ -71,29 +62,45 @@ , wl-pprint-text default-language: Haskell2010 -test-suite test-circuit-compiler +test-suite pairing-tests type: exitcode-stdio-1.0 main-is: Driver.hs other-modules: + Pairing.ByteRepr + Pairing.CyclicGroup + Pairing.Fq + Pairing.Fr + Pairing.Group + Pairing.Hash + Pairing.Jacobian + Pairing.Modular + Pairing.Pairing + Pairing.Params + Pairing.Point + Pairing.Serialize.Jivsov + Pairing.Serialize.MCLWasm + Pairing.Serialize.Types TestCommon TestFields TestGroups TestPairing Paths_pairing hs-source-dirs: + src tests - default-extensions: FlexibleContexts + default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances FlexibleContexts ScopedTypeVariables RankNTypes DataKinds DeriveAnyClass DeriveFunctor DeriveGeneric MultiParamTypeClasses TypeApplications TypeSynonymInstances build-depends: - QuickCheck - , arithmoi - , base + MonadRandom + , QuickCheck + , arithmoi >=0.8 + , base >=4.7 && <5 , binary , bytestring - , cryptonite , errors + , galois-field >=0.2 + , hexstring , integer-logarithms , memory - , pairing , protolude >=0.2 , quickcheck-instances , random @@ -110,19 +117,21 @@ other-modules: BenchPairing hs-source-dirs: - bench, tests + src + bench + default-extensions: NoImplicitPrelude OverloadedStrings FlexibleInstances FlexibleContexts ScopedTypeVariables RankNTypes DataKinds DeriveAnyClass DeriveFunctor DeriveGeneric MultiParamTypeClasses TypeApplications build-depends: - QuickCheck - , arithmoi + MonadRandom + , QuickCheck + , arithmoi >=0.8 , base >=4.7 && <5 , binary , bytestring , criterion - , cryptonite , errors + , galois-field >=0.2 , integer-logarithms , memory - , pairing , protolude >=0.2 , quickcheck-instances , random diff --git a/src/Pairing/ByteRepr.hs b/src/Pairing/ByteRepr.hs --- a/src/Pairing/ByteRepr.hs +++ b/src/Pairing/ByteRepr.hs @@ -1,33 +1,52 @@ -module Pairing.ByteRepr where - -import Protolude -import Data.ByteString as B -import Data.ByteString.Builder - -class ByteRepr a where - mkRepr :: a -> Maybe ByteString - fromRepr :: a -> ByteString -> Maybe a - reprLength :: a -> 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 x = ( b, i ) - where - b = changeSign (fromInteger x) - i | x >= 128 = Just (x `shiftR` 8 ) - | otherwise = Nothing - -toPaddedBytes :: Int -> Integer -> Maybe ByteString -toPaddedBytes len a = if B.length bs > len then Nothing else Just (B.append (B.replicate (len - B.length bs) 0x0) bs) - where - bs = toBytes a - -fromBytesToInteger :: ByteString -> Integer -fromBytesToInteger = B.foldl' f 0 - where +module Pairing.ByteRepr ( + ByteRepr(..), + toBytes, + toPaddedBytes, + fromBytesToInteger, + ByteOrder(..), + ByteOrderLength(..) +) where + +import Protolude + +import Data.ByteString as B + +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 x = (b, i) + where + b = changeSign (fromInteger x) + i | x >= 128 = Just (x `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 diff --git a/src/Pairing/CyclicGroup.hs b/src/Pairing/CyclicGroup.hs --- a/src/Pairing/CyclicGroup.hs +++ b/src/Pairing/CyclicGroup.hs @@ -1,16 +1,16 @@ module Pairing.CyclicGroup ( AsInteger(..) , CyclicGroup(..) - , sumG , FromX(..) - , Validate (..) + , Validate(..) + , sumG ) where import Protolude -import Crypto.Random (MonadRandom) -import Data.ByteString.Builder -import Data.ByteString as BS +import Control.Monad.Random (MonadRandom) +import PrimeField (PrimeField, toInt) + class AsInteger a where asInteger :: a -> Integer @@ -21,7 +21,7 @@ order :: Proxy g -> Integer expn :: AsInteger e => g -> e -> g inverse :: g -> g - random :: (MonadRandom m) => g -> m g + random :: MonadRandom m => m g -- | Sum all the elements of some container according to its group -- structure. @@ -34,10 +34,14 @@ instance AsInteger Integer where asInteger = identity +-- Temporary solution. +-- TODO: Maybe move these definitions to galois-field library +instance AsInteger (PrimeField p) where + asInteger = toInt + class FromX a where - yFromX :: a -> LargestY -> Maybe a - isLargestY :: a -> Bool + yFromX :: a -> (a -> a -> a) -> Maybe a + isOdd :: a -> Bool class Validate a where isValidElement :: a -> Bool - diff --git a/src/Pairing/Fq.hs b/src/Pairing/Fq.hs --- a/src/Pairing/Fq.hs +++ b/src/Pairing/Fq.hs @@ -1,136 +1,283 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + -- | Prime field with characteristic _q, over which the elliptic curve --- is defined and the other finite field extensions. First field in --- the tower: +-- is defined and the other finite field extensions. -- -- * Fq -- * Fq2 := Fq[u]/u^2 + 1 -- * Fq6 := Fq2[v]/v^3 - (9 + u) -- * Fq12 := Fq6[w]/w^2 - v --- -module Pairing.Fq ( - Fq(..), - new, - fqInv, - fqZero, - fqOne, - fqNqr, - fqPow, - fqSqrt, - random, - fqYforX, - fromBytesToInteger -) where +{-# LANGUAGE ViewPatterns #-} +module Pairing.Fq + ( Fq + , Fq2 + , Fq6 + , Fq12 + , fqSqrt + , fq2Sqrt + , fqYforX + , fq2YforX + , fqNqr + , xi + , mulXi + , fq2Conj + , fq2ScalarMul + , construct + , deconstruct + , fq12Conj + , fq12Frobenius + ) where + import Protolude -import Crypto.Random (MonadRandom) -import Crypto.Number.Generate (generateMax) -import Pairing.Params as Params -import Pairing.CyclicGroup (AsInteger(..), FromX(..)) + +import Data.ByteString as B (splitAt, length) +import ExtensionField (ExtensionField, IrreducibleMonic(..), fromField, fromList, t, x) +import GaloisField (GaloisField(..)) +import Math.NumberTheory.Moduli.Class (powMod) +import PrimeField (PrimeField, toInt) + import Pairing.ByteRepr -import Pairing.Modular as M -import qualified Data.ByteString as BS -import Data.Bits -import Math.NumberTheory.Moduli.Class -import Math.NumberTheory.Moduli.Sqrt +import Pairing.CyclicGroup +import Pairing.Modular +import Pairing.Params ------------------------------------------------------------------------------- -- Types ------------------------------------------------------------------------------- --- | Prime field with characteristic @_q@ -newtype Fq = Fq Integer -- ^ Use @new@ instead of this - -- constructor - deriving (Show, Eq, Bits, Generic, NFData, Ord) +-- | Prime field @Fq@ with characteristic @_q@ +type Fq = PrimeField 21888242871839275222246405745257275088696311157297823662689037894645226208583 -instance AsInteger Fq where - asInteger (Fq n) = n +-- | Quadratic irreducible monic polynomial @f(u) = u^2 + 1@ +data PolynomialU +instance IrreducibleMonic Fq PolynomialU where + split _ = x^2 + 1 +-- | Quadratic extension field of @Fq@ defined as @Fq2 = Fq[u]/@ +type Fq2 = ExtensionField Fq PolynomialU -instance Num Fq where - (+) = fqAdd - (*) = fqMul - abs = fqAbs - signum = fqSig - negate = fqNeg - fromInteger = new +-- | Cubic irreducible monic polynomial @g(v) = v^3 - (9 + u)@ +data PolynomialV +instance IrreducibleMonic Fq2 PolynomialV where + split _ = x^3 - (9 + t x) -instance Fractional Fq where - (/) = fqDiv - fromRational (a :% b) = Fq a / Fq b +-- | Cubic extension field of @Fq2@ defined as @Fq6 = Fq2[v]/@ +type Fq6 = ExtensionField Fq2 PolynomialV +-- | Quadratic irreducible monic polynomial @h(w) = w^2 - v@ +data PolynomialW +instance IrreducibleMonic Fq6 PolynomialW where + split _ = x^2 - t x + +-- | Quadratic extension field of @Fq6@ defined as @Fq12 = Fq6[w]/@ +type Fq12 = ExtensionField Fq6 PolynomialW + +------------------------------------------------------------------------------- +-- Instances +------------------------------------------------------------------------------- + +instance Ord Fq where + compare = on compare toInt + +instance Ord Fq2 where + compare = on compare fromField + instance FromX Fq where yFromX = fqYforX - isLargestY y = y > negate y + isOdd y = odd (toInt y) +instance FromX Fq2 where + yFromX = fq2YforX + isOdd a = case fromField a of -- This is generalised from the MCL implementation where in Fq2 oddness is based on the first element + (x : xs) -> isOdd x + [] -> False -- Assume zero + instance ByteRepr Fq where - mkRepr f@(Fq a) = toPaddedBytes (reprLength f) a - fromRepr _ bs = Just (Fq $ fromBytesToInteger bs) - reprLength _ = 32 + mkRepr bo = toPaddedBytes bo <$> toInt + fromRepr bo _ bs = Just (fromInteger (fromBytesToInteger (byteOrder bo) bs)) + calcReprLength _ n = n --- | Turn an integer into an @Fq@ number, should be used instead of --- the @Fq@ constructor. -new :: Integer -> Fq -new a = Fq $ withQ (getVal . newMod a) +instance ByteRepr Fq2 where + mkRepr bo f2 = do + bites <- fq2Bytes f2 + (foldl' (<>) mempty . map (mkRepr bo)) bites + fromRepr bo fq2 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 (fromList [x, y]) + calcReprLength _ n = 2 * calcReprLength (1 :: Fq) n -{-# INLINE fqAdd #-} -fqAdd :: Fq -> Fq -> Fq -fqAdd (Fq a) (Fq b) = Fq $ withQ (modBinOp a b (+)) +instance ByteRepr Fq6 where + mkRepr bo f6 = do + bites <- fq6Bytes f6 + (foldl' (<>) mempty . map (mkRepr bo)) bites + fromRepr bo fq6 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 (fromList [x, y, z]) + calcReprLength _ n = 3 * calcReprLength (1 :: Fq2) n -{-# INLINE fqAbs #-} -fqAbs :: Fq -> Fq -fqAbs (Fq a) = Fq a +instance ByteRepr Fq12 where + mkRepr bo f12= do + bites <- fq12Bytes f12 + (foldl' (<>) mempty . map (mkRepr bo)) bites + fromRepr bo fq12 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 (fromList [x, y]) + calcReprLength _ n = 2 * calcReprLength (1 :: Fq6) n -{-# INLINE fqSig #-} -fqSig :: Fq -> Fq -fqSig (Fq a) = Fq $ withQ (modUnOp a signum) +------------------------------------------------------------------------------- +-- Y for X +------------------------------------------------------------------------------- -{-# INLINE fqMul #-} -fqMul :: Fq -> Fq -> Fq -fqMul (Fq a) (Fq b) = Fq $ withQ (modBinOp a b (*)) +fqSqrt :: (Fq -> Fq -> Fq) -> Fq -> Maybe Fq +fqSqrt ysel a = case withQM (modUnOpMTup (toInt a) bothSqrtOf) of + Just (y1, y2) -> Just (ysel (fromInteger y1) (fromInteger y2)) + Nothing -> Nothing -{-# INLINE fqNeg #-} -fqNeg :: Fq -> Fq -fqNeg (Fq a) = Fq $ withQ (modUnOp a negate) +-- | Square root of Fq2 are specified by https://eprint.iacr.org/2012/685.pdf, +-- Algorithm 9 with lots of help from https://docs.rs/pairing/0.14.1/src/pairing/bls12_381/fq2.rs.html#162-222 +-- This implementation appears to return the larger square root so check the +-- return value and negate as necessary +fq2Sqrt :: Fq2 -> Maybe Fq2 +fq2Sqrt a = do + let a1 = pow a qm3by4 + let alpha = pow a1 2 * a + let a0 = pow alpha _q * alpha + if a0 == -1 then Nothing else do + let x0 = a1 * a + if alpha == -1 then Just (a1 * fromList [0, 1]) else do + let b = pow (alpha + 1) qm1by2 + Just (b * x0) + where + qm3by4 = withQ (modBinOp (_q -3) 4 (/)) + qm1by2 = withQ (modBinOp (_q -1) 2 (/)) -{-# INLINE fqDiv #-} -fqDiv :: Fq -> Fq -> Fq -fqDiv (Fq a) (Fq b) = Fq $ withQ (modBinOp a b (/)) +fqYforX :: Fq -> (Fq -> Fq -> Fq) -> Maybe Fq +fqYforX x ysel = fqSqrt ysel (pow x 3 + fromInteger _b) -{-# INLINE fqPow #-} -fqPow :: Integral e => Fq -> e -> Fq -fqPow (Fq a) b = Fq $ withQ (modUnOp a (flip powMod b)) +-- https://docs.rs/pairing/0.14.1/src/pairing/bls12_381/ec.rs.html#102-124 +fq2YforX :: Fq2 -> (Fq2 -> Fq2 -> Fq2) -> Maybe Fq2 +fq2YforX x ly = do + y <- newy + pure (ly y (negate y)) + where + newy = fq2Sqrt (pow x 3 + fromInteger _b / xi) -{-# INLINE fqNqr #-} +------------------------------------------------------------------------------- +-- Non-residues +------------------------------------------------------------------------------- + -- | Quadratic non-residue fqNqr :: Fq -fqNqr = Fq Params._nqr +fqNqr = fromInteger _nqr +{-# INLINE fqNqr #-} -{-# INLINE fqInv #-} --- | Multiplicative inverse -fqInv :: Fq -> Fq -fqInv x = 1 / x +-- | Cubic non-residue in @Fq2@ +xi :: Fq2 +xi = fromList [fromInteger _xiA, fromInteger _xiB] -{-# INLINE fqZero #-} --- | Additive identity -fqZero :: Fq -fqZero = Fq 0 +-- | Multiply by @xi@ (cubic nonresidue in @Fq2@) and reorder coefficients +mulXi :: Fq6 -> Fq6 +mulXi w = case fromField w of + [x, y, z] -> fromList [z * xi, x, y] + [x, y] -> fromList [0, x, y] + [x] -> fromList [0, x] + [] -> fromList [] + _ -> panic "mulXi not exhaustive." +{-# INLINE mulXi #-} -{-# INLINE fqOne #-} --- | Multiplicative identity -fqOne :: Fq -fqOne = Fq 1 +------------------------------------------------------------------------------- +-- Byte lists +------------------------------------------------------------------------------- -fqSqrt :: Bool -> Fq -> Maybe Fq -fqSqrt largestY (Fq a) = do - (y1, y2) <- withQM (modUnOpMTup a bothSqrtOf) - Fq <$> if largestY then Just (max y1 y2) else Just (min y1 y2) +fq2Bytes :: Fq2 -> Maybe [Fq] +fq2Bytes w = case fromField w of + [x, y] -> Just [x, y] + [x] -> Just [x, 0] + [] -> Just [0, 0] + _ -> Nothing -random :: MonadRandom m => m Fq -random = do - seed <- generateMax _q - pure (Fq seed) +fq6Bytes :: Fq6 -> Maybe [Fq2] +fq6Bytes w = case fromField w of + [x, y, z] -> Just [x, y, z] + [x, y] -> Just [x, y, 0] + [x] -> Just [x, 0, 0] + [] -> Just [0, 0, 0] + _ -> Nothing +fq12Bytes :: Fq12 -> Maybe [Fq6] +fq12Bytes w = case fromField w of + [x, y] -> Just [x, y] + [x] -> Just [x, 0] + [] -> Just [0, 0] + _ -> Nothing -fqYforX :: Fq -> Bool -> Maybe Fq -fqYforX x largestY = fqSqrt largestY (x `fqPow` 3 + new _b) - +------------------------------------------------------------------------------- +-- Fq2 and Fq12 +------------------------------------------------------------------------------- + +-- | Conjugation +fq2Conj :: Fq2 -> Fq2 +fq2Conj x = case fromField x of + [y, z] -> fromList [y, -z] + [y] -> fromList [y] + [] -> 0 + _ -> panic "fq2Conj not exhaustive." + +-- | Multiplication by a scalar in @Fq@ +fq2ScalarMul :: Fq -> Fq2 -> Fq2 +fq2ScalarMul a x = fromList [a] * x + +-- | Conjugation +fq12Conj :: Fq12 -> Fq12 +fq12Conj x = case fromField x of + [y, z] -> fromList [y, -z] + [y] -> fromList [y] + [] -> 0 + _ -> panic "fq12Conj not exhaustive." + +-- | Create a new value in @Fq12@ by providing a list of twelve coefficients +-- in @Fq@, should be used instead of the @Fq12@ constructor. +construct :: [Fq] -> Fq12 +construct [a, b, c, d, e, f, g, h, i, j, k, l] = fromList + [ fromList [fromList [a, b], fromList [c, d], fromList [e, f]] + , fromList [fromList [g, h], fromList [i, j], fromList [k, l]] ] +construct _ = panic "Invalid arguments to fq12" + +-- | Deconstruct a value in @Fq12@ into a list of twelve coefficients in @Fq@. +deconstruct :: Fq12 -> [Fq] +deconstruct = concatMap fromField . concatMap fromField . fromField + +-- | Iterated Frobenius automorphism +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" + +-- | Fast Frobenius automorphism +fastFrobenius :: Fq12 -> Fq12 +fastFrobenius = collapse . convert [[0,2,4],[1,3,5]] . conjugate + where + conjugate :: Fq12 -> [[Fq2]] + conjugate = map (map fq2Conj . fromField) . fromField + convert :: [[Integer]] -> [[Fq2]] -> [[Fq2]] + convert = zipWith (zipWith (\x y -> pow xi ((x * (_q - 1)) `div` 6) * y)) + collapse :: [[Fq2]] -> Fq12 + collapse = fromList . map fromList diff --git a/src/Pairing/Fq12.hs b/src/Pairing/Fq12.hs deleted file mode 100644 --- a/src/Pairing/Fq12.hs +++ /dev/null @@ -1,153 +0,0 @@ -{-# LANGUAGE Strict #-} -{-# LANGUAGE DeriveAnyClass, DeriveGeneric #-} - --- | Final quadratic extension of the tower: --- --- * Fq --- * Fq2 := Fq[u]/u^2 + 1 --- * Fq6 := Fq2[v]/v^3 - (9 + u) --- * Fq12 := Fq6[w]/w^2 - v --- --- Implementation follows "Multiplication and Squaring on --- Pairing-Friendly Fields" by Devigili, hEigeartaigh, Scott and --- Dahab. -module Pairing.Fq12 ( - Fq12(..), - new, - deconstruct, - fq12inv, - fq12one, - fq12zero, - fq12conj, - fq12frobenius, - random -) where - -import Protolude -import Crypto.Random (MonadRandom) - -import Pairing.Fq (Fq) -import Pairing.Fq6 (Fq6(..)) -import qualified Pairing.Fq2 as Fq2 -import qualified Pairing.Fq6 as Fq6 -import Pairing.CyclicGroup (AsInteger(..), FromX(..)) -import Pairing.Params -import Pairing.ByteRepr -import Data.ByteString as B (length, splitAt) - --- | Field extension defined as Fq6[w]/w^2 - v -data Fq12 = Fq12 { fq12x :: Fq6, fq12y :: Fq6 } -- ^ Use @new@ instead - -- of this constructor - deriving (Eq, Show, Generic, NFData) - -instance Num Fq12 where - (+) = fq12add - (*) = fq12mul - negate = fq12neg - fromInteger = fq12int - abs = panic "abs not defined for fq12" - signum = panic "signum not defined for fq12" - -instance Fractional Fq12 where - (/) = fq12div - fromRational (a :% b) = fq12int a / fq12int b - -instance ByteRepr Fq12 where - mkRepr (Fq12 x y) = mkRepr x <> mkRepr y - fromRepr (Fq12 x _) bs = do - let (xbs, ybs) = B.splitAt (reprLength x) bs - x <- fromRepr Fq6.fq6one xbs - y <- fromRepr Fq6.fq6one ybs - Just (Fq12 x y) - reprLength (Fq12 x y) = reprLength x + reprLength y - --- | Create a new value in @Fq12@ by providing a list of twelve --- coefficients in @Fq@, should be used instead of the @Fq12@ --- constructor. -new :: [Fq] -> Fq12 -new [a,b,c,d,e,f,g,h,i,j,k,l] = Fq12 - (Fq6.new (Fq2.new a b) (Fq2.new c d) (Fq2.new e f)) - (Fq6.new (Fq2.new g h) (Fq2.new i j) (Fq2.new k l)) -new _ = panic "Invalid arguments to fq12" - --- | Deconstruct a value in @Fq12@ into a list of twelve coefficients in @Fq@. -deconstruct :: Fq12 -> [Fq] -deconstruct (Fq12 - (Fq6.Fq6 (Fq2.Fq2 a b) (Fq2.Fq2 c d) (Fq2.Fq2 e f)) - (Fq6.Fq6 (Fq2.Fq2 g h) (Fq2.Fq2 i j) (Fq2.Fq2 k l))) - = [a,b,c,d,e,f,g,h,i,j,k,l] - -fq12int :: Integer -> Fq12 -fq12int n = new (fromIntegral n : replicate 11 0) - --- | Multiplicative identity -fq12one :: Fq12 -fq12one = fq12int 1 - --- | Additive identity -fq12zero :: Fq12 -fq12zero = fq12int 0 - -fq12add :: Fq12 -> Fq12 -> Fq12 -fq12add (Fq12 x y) (Fq12 a b) = Fq12 (x+a) (y+b) - -fq12neg :: Fq12 -> Fq12 -fq12neg (Fq12 x y) = Fq12 (negate x) (negate y) - -fq12div :: Fq12 -> Fq12 -> Fq12 -fq12div a b = a * fq12inv b - -fq12mul :: Fq12 -> Fq12 -> Fq12 -fq12mul (Fq12 x y) (Fq12 a b) = Fq12 (Fq6.mulXi bb + aa) ((x+y) * (a+b) - aa - bb) - where - aa = x*a - bb = y*b - --- | Multiplicative inverse -{-# INLINEABLE fq12inv #-} -fq12inv :: Fq12 -> Fq12 -fq12inv (Fq12 a b) = Fq12 (a*t) (-(b*t)) - where - t = Fq6.fq6inv (a^2 - Fq6.mulXi (b^2)) - --- | Conjugation -fq12conj :: Fq12 -> Fq12 -fq12conj (Fq12 x y) = Fq12 x (negate y) - --- | Iterated Frobenius automorphism -fq12frobenius :: Int -> Fq12 -> Fq12 -fq12frobenius i a - | i == 0 = a - | i == 1 = fastFrobenius1 a - | i > 1 = let prev = fq12frobenius (i - 1) a - in fastFrobenius1 prev - | otherwise = panic "fq12frobenius not defined for negative values of i" - -fastFrobenius1 :: Fq12 -> Fq12 -fastFrobenius1 (Fq12 (Fq6.Fq6 x0 x1 x2) (Fq6.Fq6 y0 y1 y2)) = - let - t1 = Fq2.fq2conj x0 - t2 = Fq2.fq2conj y0 - t3 = Fq2.fq2conj x1 - t4 = Fq2.fq2conj y1 - t5 = Fq2.fq2conj x2 - t6 = Fq2.fq2conj y2 - gamma1 :: Integer -> Fq2.Fq2 - gamma1 i = Fq2.xi ^ ((i * (_q - 1)) `div` 6) - t11 = t1 - t21 = t2 * gamma1 1 - t31 = t3 * gamma1 2 - t41 = t4 * gamma1 3 - t51 = t5 * gamma1 4 - t61 = t6 * gamma1 5 - c0 = Fq6 t11 t31 t51 - c1 = Fq6 t21 t41 t61 - in Fq12 c0 c1 - - - -random :: MonadRandom m => m Fq12 -random = do - x <- Fq6.random - y <- Fq6.random - pure (Fq12 x y) diff --git a/src/Pairing/Fq2.hs b/src/Pairing/Fq2.hs deleted file mode 100644 --- a/src/Pairing/Fq2.hs +++ /dev/null @@ -1,192 +0,0 @@ -{-# LANGUAGE Strict #-} -{-# LANGUAGE DeriveAnyClass, DeriveGeneric #-} - --- | First quadratic extension of the tower: --- --- * Fq --- * Fq2 := Fq[u]/u^2 + 1 --- * Fq6 := Fq2[v]/v^3 - (9 + u) --- * Fq12 := Fq6[w]/w^2 - v --- --- Implementation following "Multiplication and Squaring on --- Pairing-Friendly Fields" by Devigili, hEigeartaigh, Scott and --- Dahab. -module Pairing.Fq2 ( - Fq2(..), - Pairing.Fq2.new, - fq2scalarMul, - fq2inv, - fq2one, - fq2zero, - fq2conj, - fq2sqr, - fq2sqrt, - fq2pow, - fq2YforX, - mulXi, - divXi, - xi, - Pairing.Fq2.random, -) where - -import Protolude -import Crypto.Random (MonadRandom) -import Pairing.Modular -import Pairing.Fq as Fq -import qualified Pairing.Params as Params -import Data.Bits -import Data.ByteString as B (length, splitAt) -import Pairing.CyclicGroup (AsInteger(..), FromX(..)) -import Pairing.ByteRepr - --- | Quadratic extension of @Fq@ defined as @Fq[u]/x^2 + 1@ -data Fq2 = Fq2 { fq2x :: Fq, fq2y :: Fq } -- ^ Use @new@ instead of - -- this contructor - deriving (Eq, Show, Generic, NFData) - --- | @new x y@ creates a value representing @x + y * u @ -new :: Fq -> Fq -> Fq2 -new = Fq2 - -instance Num Fq2 where - (+) = fq2add - (*) = fq2mul - negate = fq2neg - fromInteger = fq2int - abs = panic "abs not defined for fq2" - signum = panic "signum not defined for fq2" - -instance Fractional Fq2 where - (/) = fq2div - fromRational (a :% b) = fq2int a / fq2int b - -instance Ord Fq2 where - compare (Fq2 x y) (Fq2 a b) - | compare x a == EQ = compare y b - | otherwise = compare x a - -instance FromX Fq2 where - yFromX = fq2YforX - isLargestY y = y > negate y - -instance ByteRepr Fq2 where - mkRepr (Fq2 x y) = mkRepr x <> mkRepr y - fromRepr (Fq2 x _) bs = do - let (xbs, ybs) = B.splitAt (reprLength x) bs - Just (Fq2 (Fq $ fromBytesToInteger xbs) (Fq $ fromBytesToInteger ybs)) - reprLength (Fq2 x y) = reprLength x + reprLength y - --- | Cubic non-residue in @Fq2@ -xi :: Fq2 -xi = Fq2 xiA xiB - where - xiA, xiB :: Fq - xiA = Fq.new Params._xiA - xiB = Fq.new Params._xiB - --- | Multiplicative identity -fq2one :: Fq2 -fq2one = fq2int 1 - --- | Additive identity -fq2zero :: Fq2 -fq2zero = fq2int 0 - -fq2int :: Integer -> Fq2 -fq2int n = Fq2 (fromInteger n) fqZero - -fq2neg :: Fq2 -> Fq2 -fq2neg (Fq2 x y) = Fq2 (-x) (-y) - -fq2add :: Fq2 -> Fq2 -> Fq2 -fq2add (Fq2 x y) (Fq2 a b) = Fq2 (x+a) (y+b) - -fq2div :: Fq2 -> Fq2 -> Fq2 -fq2div a b = fq2mul a (fq2inv b) - -fq2mul :: Fq2 -> Fq2 -> Fq2 -fq2mul (Fq2 a0 a1) (Fq2 b0 b1) = Fq2 c0 c1 - where - aa = a0 * b0 - bb = a1 * b1 - c0 = bb * fqNqr + aa - c1 = (a0 + a1) * (b0 + b1) - aa - bb - --- | Multiplication by a scalar in @Fq@ -fq2scalarMul :: Fq -> Fq2 -> Fq2 -fq2scalarMul a (Fq2 x y) = Fq2 (a*x) (a*y) - --- | Multiply by @xi@ -mulXi :: Fq2 -> Fq2 -mulXi = (* xi) - --- | Divide by @xi@ -divXi :: Fq2 -> Fq2 -divXi = (/ xi) - --- | Squaring operation -fq2sqr :: Fq2 -> Fq2 -fq2sqr (Fq2 a0 a1) = Fq2 c0 c1 - where - aa = a0 * a0 - bb = a1 * a1 - c0 = bb * fqNqr + aa - c1 = (a0 + a1) * (a0 + a1) - aa - bb - -{-# INLINE fq2pow #-} -fq2pow :: Fq2 -> Integer -> Fq2 -fq2pow b 0 = fq2one -fq2pow b e = t * fq2pow (b * b) (shiftR e 1) - where - t = if testBit e 0 then b else fq2one - --- | Multiplicative inverse -fq2inv :: Fq2 -> Fq2 -fq2inv (Fq2 a0 a1) = Fq2 c0 c1 - where - t = fqInv ((a0 ^ 2) - ((a1 ^ 2) * fqNqr)) - c0 = a0 * t - c1 = -(a1 * t) - --- | Conjugation -fq2conj :: Fq2 -> Fq2 -fq2conj (Fq2 x y) = Fq2 x (negate y) - --- | Square root of Fq2 are specified by https://eprint.iacr.org/2012/685.pdf, Algorithm 9 --- with lots of help from https://docs.rs/pairing/0.14.1/src/pairing/bls12_381/fq2.rs.html#162-222 --- This implementation appears to return the larger square root so check the return value and --- negate as necessary -fq2sqrt :: Fq2 -> Maybe Fq2 -fq2sqrt a = do - let a1 = a `fq2pow` qm3by4 - let alpha = (fq2sqr a1) * a - let a0 = (alpha `fq2pow` Params._q) * alpha - if a0 == neg1 then Nothing else do - let x0 = a1 * a - if alpha == neg1 then Just (a1 `fq2mul` Pairing.Fq2.new fqZero fqOne) else do - let b = (alpha + fq2one) `fq2pow` qm1by2 - Just (b * x0) - where - neg1 = Pairing.Fq2.new (negate fqOne) fqZero - qm3by4 = withQ (modBinOp (Params._q -3) 4 (/)) - qm1by2 = withQ (modBinOp (Params._q -1) 2 (/)) - -random :: MonadRandom m => m Fq2 -random = do - x <- Fq.random - y <- Fq.random - pure (Fq2 x y) - --- https://docs.rs/pairing/0.14.1/src/pairing/bls12_381/ec.rs.html#102-124 -fq2YforX :: Fq2 -> Bool -> Maybe Fq2 -fq2YforX x ly - | ly = newy - | otherwise = negate <$> newy - where - newy = fq2sqrt (x `fq2pow` 3 + Fq2 (b * inv_xi_a) (b * inv_xi_b)) - (Fq2 inv_xi_a inv_xi_b) = fq2inv xi - b = Fq Params._b - - - - diff --git a/src/Pairing/Fq6.hs b/src/Pairing/Fq6.hs deleted file mode 100644 --- a/src/Pairing/Fq6.hs +++ /dev/null @@ -1,126 +0,0 @@ -{-# LANGUAGE Strict #-} -{-# LANGUAGE DeriveAnyClass, DeriveGeneric #-} - --- | Cubic extension of the tower: --- --- * Fq --- * Fq2 := Fq[u]/u^2 + 1 --- * Fq6 := Fq2[v]/v^3 - (9 + u) --- * Fq12 := Fq6[w]/w^2 - v --- --- Implementation follows "Multiplication and Squaring on --- Pairing-Friendly Fields" by Devigili, hEigeartaigh, Scott and --- Dahab. -module Pairing.Fq6 ( - Fq6(..), - new, - fq6inv, - fq6one, - fq6zero, - fq6sqr, - mulXi, - random -) where - -import Protolude -import Crypto.Random (MonadRandom) - -import Pairing.Fq2 (Fq2) -import qualified Pairing.Fq2 as Fq2 -import Pairing.CyclicGroup (AsInteger(..), FromX(..)) -import Data.ByteString as B (length, splitAt) -import Pairing.ByteRepr - --- | Field extension defined as Fq2[v]/v^3 - (9 + u) -data Fq6 - = Fq6 - { fq6x :: Fq2 - , fq6y :: Fq2 - , fq6z :: Fq2 - } - deriving (Eq, Show, Generic, NFData) - -instance Num Fq6 where - (+) = fq6add - (*) = fq6mul - negate = fq6neg - fromInteger = fq6int - abs = panic "abs not defined for fq6" - signum = panic "signum not defined for fq6" - -instance Fractional Fq6 where - (/) = fq6div - fromRational (a :% b) = fq6int a / fq6int b - -instance ByteRepr Fq6 where - mkRepr (Fq6 x y z) = mkRepr x <> mkRepr y <> mkRepr z - fromRepr (Fq6 x _ _) bs = do - let (xbs, yzbs) = B.splitAt (reprLength x) bs - let (ybs, zbs) = B.splitAt (reprLength x) yzbs - x <- fromRepr Fq2.fq2one xbs - y <- fromRepr Fq2.fq2one ybs - z <- fromRepr Fq2.fq2one zbs - Just (Fq6 x y z) - reprLength (Fq6 x y z) = reprLength x + reprLength y + reprLength z - --- | Create a new value in @Fq6@, should be used instead of the @Fq6@ --- constructor. -new :: Fq2 -> Fq2 -> Fq2 -> Fq6 -new = Fq6 - --- | Additive identity -fq6zero :: Fq6 -fq6zero = Fq6 0 0 0 - -fq6int :: Integer -> Fq6 -fq6int n = Fq6 (fromInteger n) 0 0 - --- | Multiplicative identity -fq6one :: Fq6 -fq6one = Fq6 1 0 0 - -fq6add :: Fq6 -> Fq6 -> Fq6 -fq6add (Fq6 x y z) (Fq6 a b c) = Fq6 (x+a) (y+b) (z+c) - -fq6neg :: Fq6 -> Fq6 -fq6neg (Fq6 x y z) = Fq6 (-x) (-y) (-z) - --- | Squaring operation -fq6sqr :: Fq6 -> Fq6 -fq6sqr x = x^2 - -fq6div :: Fq6 -> Fq6 -> Fq6 -fq6div a b = a * fq6inv b - -fq6mul :: Fq6 -> Fq6 -> Fq6 -fq6mul (Fq6 a0 a1 a2) (Fq6 b0 b1 b2) = Fq6 c0 c1 c2 - where - t0 = a0 * b0 - t1 = a1 * b1 - t2 = a2 * b2 - c0 = Fq2.mulXi ((a1+a2) * (b1+b2) - t1 - t2) + t0 - c1 = ((a0+a1) * (b0+b1)) - t0 - t1 + Fq2.mulXi t2 - c2 = ((a0+a2) * (b0+b2)) - t0 + t1 - t2 - --- | Multiply by @xi@ (cubic nonresidue in @Fq2@) and reorder --- coefficients -{-# INLINABLE mulXi #-} -mulXi :: Fq6 -> Fq6 -mulXi (Fq6 x y z) = Fq6 (z*Fq2.xi) x y - --- | Multiplicative inverse -fq6inv :: Fq6 -> Fq6 -fq6inv (Fq6 a b c) = Fq6 (t*c0) (t*c1) (t*c2) - where - c0 = a^2 - b * c * Fq2.xi - c1 = c^2 * Fq2.xi - a * b - c2 = b^2 - a*c - t = Fq2.fq2inv ((c * c1 + b * c2) * Fq2.xi + a*c0) - - -random :: MonadRandom m => m Fq6 -random = do - a <- Fq2.random - b <- Fq2.random - c <- Fq2.random - pure (Fq6 a b c) diff --git a/src/Pairing/Fr.hs b/src/Pairing/Fr.hs --- a/src/Pairing/Fr.hs +++ b/src/Pairing/Fr.hs @@ -1,99 +1,40 @@ -{-# LANGUAGE Strict #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} -- | Prime field from which exponents should be chosen -module Pairing.Fr ( - Fr(..), - new, - frInv, - frPow, - frAdd, - frNeg, - random, - isRootOfUnity, - isPrimitiveRootOfUnity, - primitiveRootOfUnity, - precompRootOfUnity -) where +module Pairing.Fr + ( Fr + , isRootOfUnity + , isPrimitiveRootOfUnity + , primitiveRootOfUnity + , precompRootOfUnity + ) where import Protolude -import Crypto.Random (MonadRandom) -import Crypto.Number.Generate (generateMax) -import Text.PrettyPrint.Leijen.Text +import GaloisField (GaloisField(..)) +import PrimeField (PrimeField, toInt) -import Pairing.Params -import Pairing.CyclicGroup (AsInteger(..)) +import Pairing.CyclicGroup import Pairing.Modular -import Math.NumberTheory.Moduli.Class - -instance AsInteger Fr where - asInteger (Fr n) = n - -instance Num Fr where - (+) = frAdd - (*) = frMul - abs = frAbs - signum = frSig - negate = frNeg - fromInteger n = Fr (n `mod` _r) - -instance Fractional Fr where - (/) = frDiv - fromRational (a :% b) = Fr a / Fr b - -instance Pretty Fr where - pretty (Fr fr) = pretty fr - --- | Prime field with characteristic @_r@ -newtype Fr = Fr Integer -- ^ Use @new@ instead of this constructor - deriving (Show, Eq, Ord, Bits, NFData) - --- | Turn an integer into an @Fr@ number, should be used instead of --- the @Fr@ constructor. -new :: Integer -> Fr -new a = Fr $ withR (getVal . newMod a) - -{-# INLINE frAdd #-} -frAdd :: Fr -> Fr -> Fr -frAdd (Fr a) (Fr b) = Fr $ withR (modBinOp a b (+)) - -{-# INLINE frMul #-} -frMul :: Fr -> Fr -> Fr -frMul (Fr a) (Fr b) = Fr $ withR (modBinOp a b (*)) - -{-# INLINE frAbs #-} -frAbs :: Fr -> Fr -frAbs (Fr a) = Fr a - -{-# INLINE frSig #-} -frSig :: Fr -> Fr -frSig (Fr a) = Fr $ withR (modUnOp a signum) - -{-# INLINE frNeg #-} -frNeg :: Fr -> Fr -frNeg (Fr a) = Fr $ withR (modUnOp a negate) - -{-# INLINE frDiv #-} -frDiv :: Fr -> Fr -> Fr -frDiv (Fr a) (Fr b) = Fr $ withR (modBinOp a b (/)) +import Pairing.Params -frInv :: Fr -> Fr -frInv a = 1 / a +------------------------------------------------------------------------------- +-- Types and instances +------------------------------------------------------------------------------- -frPow :: Integral e => Fr -> e -> Fr -frPow (Fr a) b = Fr $ withQ (modUnOp a (`powMod` b)) +-- | Prime field @Fr@ with characteristic @_r@ +type Fr = PrimeField 21888242871839275222246405745257275088548364400416034343698204186575808495617 -random :: MonadRandom m => m Fr -random = do - seed <- generateMax _r - pure (Fr seed) +instance Ord Fr where + compare = on compare toInt --- Roots of unity stuff +------------------------------------------------------------------------------- +-- Roots of unity +------------------------------------------------------------------------------- isRootOfUnity :: Integer -> Fr -> Bool isRootOfUnity n x - | n > 0 = x^n == 1 + | n > 0 = pow x n == 1 | otherwise = panic "isRootOfUnity: negative powers not supported" isPrimitiveRootOfUnity :: Integer -> Fr -> Bool @@ -104,14 +45,10 @@ -- | 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 -- ^ exponent of 2 for which we want to get the primitive - -- root of unity - -> 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" + | 0 <= k && k <= 28 = 5^((_r - 1) `div` (2^k)) + | otherwise = panic "primitiveRootOfUnity: no primitive root for given power of 2" precompRootOfUnity :: Int -> Fr precompRootOfUnity 0 = 1 diff --git a/src/Pairing/Group.hs b/src/Pairing/Group.hs --- a/src/Pairing/Group.hs +++ b/src/Pairing/Group.hs @@ -1,43 +1,39 @@ -{-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | Definitions of the groups the pairing is defined on -module Pairing.Group ( - CyclicGroup(..), - G1, - G2, - GT, - isOnCurveG1, - isOnCurveG2, - isInGT, - g1, - g2, - b1, - b2, - hashToG1, - groupFromX, - fromByteStringG1, - fromByteStringG2, - fromByteStringGT -) where +module Pairing.Group + ( CyclicGroup(..) + , G1 + , G2 + , GT + , b1 + , b2 + , g1 + , g2 + , groupFromX + , hashToG1 + , isInGT + , isOnCurveG1 + , isOnCurveG2 + , fromByteStringG1 + , fromByteStringG2 + , fromByteStringGT + ) where import Protolude -import Data.Semigroup -import Pairing.Fq as Fq -import Pairing.Fq2 as Fq2 -import Pairing.Fq12 as Fq12 -import Pairing.Fr as Fr -import Pairing.Point -import Pairing.Params +import Control.Monad.Random (MonadRandom) +import Data.Semigroup ((<>)) +import ExtensionField (fromList) +import GaloisField (GaloisField(..)) +import PrimeField (toInt) +import Test.QuickCheck (Arbitrary(..), Gen) import Pairing.CyclicGroup -import Test.QuickCheck +import Pairing.Fq import Pairing.Hash -import Crypto.Random (MonadRandom) -import Pairing.Modular -import System.Random -import Pairing.Serialize -import Pairing.ByteRepr +import Pairing.Params +import Pairing.Point +import Pairing.Serialize.Types -- | G1 is E(Fq) defined by y^2 = x^3 + b type G1 = Point Fq @@ -67,17 +63,11 @@ order _ = _r expn a b = gMul a (asInteger b) inverse = gNeg - random _ = randomG1 + random = randomG1 instance Validate G1 where isValidElement = isOnCurveG1 -instance ToCompressedForm G1 where - serializeCompressed = fmap toS . toCompressedForm - -instance ToUncompressedForm G1 where - serializeUncompressed = fmap toS . toUncompressedForm - instance Monoid G2 where mappend = gAdd mempty = Infinity @@ -87,30 +77,21 @@ order _ = _r expn a b = gMul a (asInteger b) inverse = gNeg - random _ = randomG2 + random = randomG2 instance Validate G2 where isValidElement = isOnCurveG2 -instance ToCompressedForm G2 where - serializeCompressed = fmap toS . toCompressedForm - -instance ToUncompressedForm G2 where - serializeUncompressed = fmap toS . toUncompressedForm - instance Monoid GT where mappend = (*) mempty = 1 instance CyclicGroup GT where - generator = notImplemented -- this should be the _r-th primitive root of unity - order = notImplemented -- should be a factor of _r - expn a b = a ^ asInteger b + generator = panic "not implemented." -- this should be the _r-th primitive root of unity + order = panic "not implemented." -- should be a factor of _r + expn a b = pow a (asInteger b) inverse = recip - random _ = Fq12.random - -instance ToUncompressedForm GT where - serializeUncompressed = fmap toS . elementToUncompressedForm + random = rnd instance Validate GT where isValidElement = isInGT @@ -123,79 +104,67 @@ g2 :: G2 g2 = Point x y where - x = Fq2 - 10857046999023057135944570762232829481370756359578518086990519993285655852781 - 11559732032986387107991004021392285783925812861821192530917403151452391805634 + x = fromList + [ 10857046999023057135944570762232829481370756359578518086990519993285655852781 + , 11559732032986387107991004021392285783925812861821192530917403151452391805634 ] - y = Fq2 - 8495653923123431417604973247489272438418190587263600148770280649306958101930 - 4082367875863433681332203403145435568316851327593401208105741076214120093531 + y = fromList + [ 8495653923123431417604973247489272438418190587263600148770280649306958101930 + , 4082367875863433681332203403145435568316851327593401208105741076214120093531 ] -- | Test whether a value in G1 satisfies the corresponding curve -- equation isOnCurveG1 :: G1 -> Bool -isOnCurveG1 Infinity - = True -isOnCurveG1 (Point x y) - = (y `fqPow` 2 == x `fqPow` 3 + Fq _b) +isOnCurveG1 Infinity = True +isOnCurveG1 (Point x y) = pow y 2 == pow x 3 + fromInteger _b -- | Test whether a value in G2 satisfies the corresponding curve -- equation isOnCurveG2 :: G2 -> Bool -isOnCurveG2 Infinity - = True -isOnCurveG2 (Point x y) - = y `fq2pow` 2 == x `fq2pow` 3 + Fq2 (b * inv_xi_a) (b * inv_xi_b) - where - (Fq2 inv_xi_a inv_xi_b) = Fq2.fq2inv Fq2.xi - b = Fq _b +isOnCurveG2 Infinity = True +isOnCurveG2 (Point x y) = pow y 2 == pow x 3 + fromList [fromInteger _b] / xi -- | Test whether a value is an _r-th root of unity isInGT :: GT -> Bool -isInGT f = f ^ _r == Fq12.fq12one +isInGT f = pow f _r == 1 -- | Parameter for curve on Fq b1 :: Fq -b1 = Fq.new _b +b1 = fromInteger _b -- | Parameter for twisted curve over Fq2 b2 :: Fq2 -b2 = Fq2 b1 0 / Fq2.xi +b2 = fromList [b1] / xi ------------------------------------------------------------------------------- -- Generators ------------------------------------------------------------------------------- -instance Arbitrary (Point Fq) where -- G1 +instance Arbitrary G1 where arbitrary = gMul g1 . abs <$> (arbitrary :: Gen Integer) -instance Arbitrary (Point Fq2) where -- G2 +instance Arbitrary G2 where arbitrary = gMul g2 . abs <$> (arbitrary :: Gen Integer) hashToG1 :: MonadRandom m => ByteString -> m (Maybe G1) hashToG1 = swEncBN -randomG1 :: (MonadRandom m) => m G1 -randomG1 = do - Fq r <- Fq.random - pure (gMul g1 r) +randomG1 :: forall m . MonadRandom m => m G1 +randomG1 = expn generator <$> (rnd :: m Fq) -randomG2 :: (MonadRandom m) => m G2 -randomG2 = do - Fq r <- Fq.random - pure (gMul g2 r) +randomG2 :: forall m . MonadRandom m => m G2 +randomG2 = expn generator <$> (rnd :: m Fq) -groupFromX :: (Validate (Point a), FromX a) => Bool -> a -> Maybe (Point a) -groupFromX largestY x = do - y <- yFromX x largestY +groupFromX :: (Validate (Point a), FromX a) => (a -> a -> a) -> a -> Maybe (Point a) +groupFromX checkF x = do + y <- yFromX x checkF if isValidElement (Point x y) then Just (Point x y) else Nothing -fromByteStringG1 :: ByteString -> Either Text G1 -fromByteStringG1 = pointFromByteString fqOne . toSL - -fromByteStringG2 :: ByteString -> Either Text G2 -fromByteStringG2 = pointFromByteString fq2one . toSL +fromByteStringG1 :: (FromSerialisedForm u) => u -> LByteString -> Either Text G1 +fromByteStringG1 unser = unserializePoint unser g1 . toSL -fromByteStringGT :: ByteString -> Either Text GT -fromByteStringGT = elementReadUncompressed fq12one . toSL +fromByteStringG2 :: (FromSerialisedForm u) => u -> LByteString -> Either Text G2 +fromByteStringG2 unser = unserializePoint unser g2 . toSL +fromByteStringGT :: (FromUncompressedForm u) => u -> LByteString -> Either Text GT +fromByteStringGT unser = unserialize unser 1 . toSL diff --git a/src/Pairing/Hash.hs b/src/Pairing/Hash.hs --- a/src/Pairing/Hash.hs +++ b/src/Pairing/Hash.hs @@ -1,17 +1,19 @@ -module Pairing.Hash ( - swEncBN +module Pairing.Hash + ( swEncBN ) where import Protolude + +import Control.Error (runMaybeT, hoistMaybe) +import Control.Monad.Random (MonadRandom) +import Data.List (genericIndex) +import Math.NumberTheory.Moduli.Class (Mod, getVal, powMod) + import Pairing.Params import Pairing.Point import Pairing.Modular as M import Pairing.Fq as Fq -import Math.NumberTheory.Moduli.Class -import Math.NumberTheory.Moduli.Sqrt -import Crypto.Random (MonadRandom) -import Data.List -import Control.Error (runMaybeT, hoistMaybe) +import Pairing.ByteRepr (ByteOrder(..)) sqrtOfMinusThree :: forall m . KnownNat m => Proxy m -> Maybe (Mod m) sqrtOfMinusThree _ = sqrtOf (-3) @@ -60,13 +62,13 @@ -- swEncBN :: MonadRandom m => ByteString -> m (Maybe (Point Fq)) swEncBN bs = runMaybeT $ withQM $ \mn -> do - let t = M.fromBytes bs mn + let t = M.fromBytes MostSignificantFirst bs mn sq3 <- hoistMaybe (sqrtOfMinusThree mn) let w' = w mn sq3 t x1' <- hoistMaybe (x1 mn t w') if (t == 0) then do onebmn <- hoistMaybe (sqrtOf (1 + (b mn))) - pure $ (Point (Fq.new (getVal x1')) (Fq.new (getVal $ onebmn))) + pure $ (Point (fromInteger (getVal x1')) (fromInteger (getVal $ onebmn))) else do let x2' = x2 mn x1' let x3' = x3 mn w' @@ -78,4 +80,4 @@ let bet = alphaBeta mn r2 x2' let i' = i al bet swy' <- hoistMaybe (swy mn r3 t (genericIndex lst (i' - 1)) (b mn)) - pure $ (Point (Fq.new (getVal $ genericIndex lst (i' - 1))) (Fq.new swy')) + pure $ (Point (fromInteger (getVal $ genericIndex lst (i' - 1))) (fromInteger swy')) diff --git a/src/Pairing/Jacobian.hs b/src/Pairing/Jacobian.hs --- a/src/Pairing/Jacobian.hs +++ b/src/Pairing/Jacobian.hs @@ -4,29 +4,27 @@ -- @(X / Z^2, Y / Z^3)@. Curve operations are more optimal in Jacobian -- coordinates when the time complexity for underlying field inversions is -- significantly higher than field multiplications. -module Pairing.Jacobian ( - JPoint, - toJacobian, - fromJacobian -) where +module Pairing.Jacobian + ( JPoint + , toJacobian + , fromJacobian + ) where import Protolude +import GaloisField (GaloisField(..)) + import Pairing.Point --- | Jacobian coordinates for points on an elliptic curve over a field --- @a@. -type JPoint a = (a,a,a) +-- | Jacobian coordinates for points on an elliptic curve over a field @k@. +type JPoint k = (k, k, k) -- | Convert affine coordinates to Jacobian coordinates -toJacobian :: Fractional a => Point a -> JPoint a -toJacobian Infinity = (1, 1, 0) -toJacobian (Point x y) = (x,y,1) +toJacobian :: GaloisField k => Point k -> JPoint k +toJacobian Infinity = (1, 1, 0) +toJacobian (Point x y) = (x, y, 1) -- | Convert Jacobian coordinates to affine coordinates -fromJacobian :: (Eq a, Fractional a) => JPoint a -> Point a -fromJacobian (x, y, z) - | z == 0 = Infinity - | otherwise = Point (x * zinv^2) (y * zinv^3) - where - zinv = recip z +fromJacobian :: GaloisField k => JPoint k -> Point k +fromJacobian (_, _, 0) = Infinity +fromJacobian (x, y, z) = Point (x * pow z (-2)) (y * pow z (-3)) diff --git a/src/Pairing/Modular.hs b/src/Pairing/Modular.hs --- a/src/Pairing/Modular.hs +++ b/src/Pairing/Modular.hs @@ -1,15 +1,15 @@ module Pairing.Modular where import Protolude + import Math.NumberTheory.Moduli.Class import Math.NumberTheory.Moduli.Sqrt -import Math.NumberTheory.UniqueFactorisation + +import Control.Monad.Random (MonadRandom(..)) + import Pairing.Params import Pairing.ByteRepr -import Crypto.Random (MonadRandom) -import Crypto.Number.Generate (generateMax) import qualified Data.ByteString as BS -import Math.NumberTheory.Logarithms withMod :: Integer -> (forall m . KnownNat m => Proxy m -> r) -> r withMod n cont = case someNatVal n of @@ -86,16 +86,14 @@ [_] -> Nothing legendre :: Integer -> Integer -legendre a = if conv > 1 then (-1) else conv +legendre a = if conv > 1 then (-1) else conv where conv = withQ (modUnOp a f) f m = m `powMod` p2 p2 = (_q - 1) `quot` 2 randomMod :: forall n m. (MonadRandom m, KnownNat n) => Proxy n -> m (Mod n) -randomMod mName = do - seed <- generateMax _q - pure (fromInteger @(Mod n) seed) +randomMod n = fromInteger <$> getRandomR (0, natVal n - 1) -fromBytes :: forall n. (KnownNat n) => ByteString -> Proxy n -> Mod n -fromBytes bs mn = newMod (fromBytesToInteger bs) mn +fromBytes :: forall n. (KnownNat n) => ByteOrder -> ByteString -> Proxy n -> Mod n +fromBytes bo bs = newMod (fromBytesToInteger bo bs) diff --git a/src/Pairing/Pairing.hs b/src/Pairing/Pairing.hs --- a/src/Pairing/Pairing.hs +++ b/src/Pairing/Pairing.hs @@ -12,17 +12,14 @@ import Protolude import Data.List ((!!)) -import Pairing.Point +import ExtensionField (fromList) +import GaloisField (GaloisField(..)) + +import Pairing.Fq import Pairing.Group import Pairing.Jacobian -import Pairing.Fq (Fq) -import qualified Pairing.Fq as Fq -import Pairing.Fq2 (Fq2) -import qualified Pairing.Fq2 as Fq2 -import Pairing.Fq6 as Fq6 -import Pairing.Fq12 (Fq12) -import qualified Pairing.Fq12 as Fq12 import Pairing.Params +import Pairing.Point -- G2, but using Jacobian coordinates type JG2 = JPoint Fq2 @@ -37,7 +34,7 @@ reducedPairing p@(Point _ _) q@(Point _ _) = finalExponentiation $ atePairing p q reducedPairing _ _ - = Fq12.fq12one + = 1 ------------------------------------------------------------------------------- -- Miller loop @@ -48,7 +45,7 @@ atePairing p@(Point _ _) q@(Point _ _) = ateMillerLoop p (atePrecomputeG2 q) atePairing _ _ - = Fq12.fq12one + = 1 -- | Binary expansion (missing the most-significant bit) representing -- the number 6 * _t + 2. @@ -69,7 +66,7 @@ -- | Miller loop with precomputed values for G2 ateMillerLoop :: G1 -> [EllCoeffs] -> GT ateMillerLoop p coeffs = let - (postLoopIx, postLoopF) = foldl' (ateLoopBody p coeffs) (0, Fq12.fq12one) ateLoopCountBinary + (postLoopIx, postLoopF) = foldl' (ateLoopBody p coeffs) (0, 1) ateLoopCountBinary almostF = mulBy024 postLoopF (prepareCoeffs coeffs p postLoopIx) finalF = mulBy024 almostF (prepareCoeffs coeffs p (postLoopIx + 1)) in finalF @@ -77,7 +74,7 @@ ateLoopBody :: G1 -> [EllCoeffs] -> (Int, Fq12) -> Bool -> (Int, Fq12) ateLoopBody p coeffs (oldIx, oldF) currentBit = let - fFirst = mulBy024 (oldF^2) (prepareCoeffs coeffs p oldIx) + fFirst = mulBy024 (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) @@ -87,14 +84,12 @@ prepareCoeffs _ Infinity _ = panic "prepareCoeffs: received trivial point" prepareCoeffs coeffs (Point px py) ix = let (EllCoeffs ell0 ellVW ellVV) = coeffs !! ix - in EllCoeffs ell0 (Fq2.fq2scalarMul py ellVW) (Fq2.fq2scalarMul px ellVV) + in EllCoeffs ell0 (fq2ScalarMul py ellVW) (fq2ScalarMul px ellVV) {-# INLINEABLE mulBy024 #-} mulBy024 :: Fq12 -> EllCoeffs -> Fq12 mulBy024 this (EllCoeffs ell0 ellVW ellVV) - = let a = Fq12.Fq12 - (Fq6.Fq6 ell0 Fq2.fq2zero ellVV) - (Fq6.Fq6 Fq2.fq2zero ellVW Fq2.fq2zero) + = let a = fromList [fromList [ell0, 0, ellVV], fromList [0, ellVW, 0]] in this * a ------------------------------------------------------------------------------- @@ -122,13 +117,13 @@ -- xi ^ ((_q - 1) `div` 3) twistMulX :: Fq2 -twistMulX = Fq2.xi ^ ((_q - 1) `div` 3) -- Fq2 +twistMulX = pow xi ((_q - 1) `div` 3) -- Fq2 -- 21575463638280843010398324269430826099269044274347216827212613867836435027261 -- 10307601595873709700152284273816112264069230130616436755625194854815875713954 -- xi ^ ((_q - 1) `div` 2) twistMulY :: Fq2 -twistMulY = Fq2.xi ^ ((_q - 1) `div` 2) -- Fq2 +twistMulY = pow xi ((_q - 1) `div` 2) -- Fq2 -- 2821565182194536844548159561693502659359617185244120367078079554186484126554 -- 3505843767911556378687030309984248845540243509899259641013678093033130930403 @@ -167,23 +162,23 @@ in (nextR, nextCoeffs) twoInv :: Fq -twoInv = Fq.fqInv $ Fq.new 2 +twoInv = 0.5 twistCoeffB :: Fq2 -twistCoeffB = Fq2.fq2scalarMul (Fq.new _b) (Fq2.fq2inv Fq2.xi) +twistCoeffB = fq2ScalarMul (fromInteger _b) (1 / xi) doublingStepForFlippedMillerLoop :: JG2 -> (JG2, EllCoeffs) doublingStepForFlippedMillerLoop (oldX, oldY, oldZ) = let - a, b, c, d, e, f, g, h, i, j, eSquared :: Fq2.Fq2 + a, b, c, d, e, f, g, h, i, j, eSquared :: Fq2 - a = Fq2.fq2scalarMul twoInv (oldX * oldY) + a = fq2ScalarMul twoInv (oldX * oldY) b = oldY * oldY c = oldZ * oldZ d = c + c + c e = twistCoeffB * d f = e + e + e - g = Fq2.fq2scalarMul twoInv (b + f) + g = fq2ScalarMul twoInv (b + f) h = (oldY + oldZ) * (oldY + oldZ) - (b + c) i = e - b j = oldX * oldX @@ -193,7 +188,7 @@ newY = g * g - (eSquared + eSquared + eSquared) newZ = b * h - ell0 = Fq2.xi * i + ell0 = xi * i ellVV = j + j + j ellVW = - h @@ -204,7 +199,7 @@ mixedAdditionStepForFlippedMillerLoop :: JG2 -> JG2 -> (JG2, EllCoeffs) mixedAdditionStepForFlippedMillerLoop _base@(x2, y2, _z2) _current@(x1, y1, z1) = let - d, e, f, g, h, i, j :: Fq2.Fq2 + d, e, f, g, h, i, j :: Fq2 d = x1 - (x2 * z1) e = y1 - (y2 * z1) f = d * d @@ -217,7 +212,7 @@ newY = e * (i - j) - (h * y1) newZ = z1 * h - ell0 = Fq2.xi * (e * x2 - d * y2) + ell0 = xi * (e * x2 - d * y2) ellVV = - e ellVW = d @@ -231,22 +226,22 @@ -- | Naive implementation of the final exponentiation step finalExponentiationNaive :: Fq12 -> GT -finalExponentiationNaive f = f ^ expVal +finalExponentiationNaive f = pow f expVal where expVal :: Integer - expVal = (_q ^ _k - 1) `div` _r + expVal = div (_q ^ _k - 1) _r -- | A faster way of performing the final exponentiation step finalExponentiation :: Fq12 -> GT -finalExponentiation f = finalExponentiationFirstChunk f ^ expVal +finalExponentiation f = pow (finalExponentiationFirstChunk f) expVal where - expVal = (_q ^ 4 - _q ^ 2 + 1) `div` _r + expVal = div (_q ^ 4 - _q ^ 2 + 1) _r finalExponentiationFirstChunk :: Fq12 -> GT finalExponentiationFirstChunk f - | f == Fq12.fq12zero = Fq12.fq12zero + | f == 0 = 0 | otherwise = let - f1 = Fq12.fq12conj f - f2 = Fq12.fq12inv f + f1 = fq12Conj f + f2 = recip f newf0 = f1 * f2 -- == f^(_q ^6 - 1) - in Fq12.fq12frobenius 2 newf0 * newf0 -- == f^((_q ^ 6 - 1) * (_q ^ 2 + 1)) + in fq12Frobenius 2 newf0 * newf0 -- == f^((_q ^ 6 - 1) * (_q ^ 2 + 1)) diff --git a/src/Pairing/Params.hs b/src/Pairing/Params.hs --- a/src/Pairing/Params.hs +++ b/src/Pairing/Params.hs @@ -8,16 +8,16 @@ -- > q = 21888242871839275222246405745257275088696311157297823662689037894645226208583 -- > r = 21888242871839275222246405745257275088548364400416034343698204186575808495617 -- > ΞΎ = 9 + u -module Pairing.Params ( - _a, - _b, - _q, - _r, - _k, - _nqr, - _xiA, - _xiB, -) where +module Pairing.Params + ( _a + , _b + , _q + , _r + , _k + , _nqr + , _xiA + , _xiB + ) where import Protolude diff --git a/src/Pairing/Point.hs b/src/Pairing/Point.hs --- a/src/Pairing/Point.hs +++ b/src/Pairing/Point.hs @@ -1,21 +1,20 @@ -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveAnyClass, DeriveGeneric #-} --- -- | Affine point arithmetic defining the group operation on an -- elliptic curve E(F), for some field F. In our case the field F is -- given as some type t with Num and Fractional instances. -module Pairing.Point ( - Point(..), - gDouble, - gAdd, - gNeg, - gMul, -) where +module Pairing.Point + ( Point(..) + , gDouble + , gAdd + , gNeg + , gMul + ) where import Protolude -import Pairing.Fq (Fq) -import Pairing.Fq2 (Fq2) +import GaloisField (GaloisField(..)) + +import Pairing.Fq (Fq, Fq2) + -- | Points on a curve over a field @a@ represented as either affine -- coordinates or as a point at infinity. data Point a @@ -37,11 +36,7 @@ -- | Point addition, provides a group structure on an elliptic curve -- with the point at infinity as its unit. -gAdd - :: (Fractional t, Eq t) - => Point t - -> Point t - -> Point t +gAdd :: GaloisField k => Point k -> Point k -> Point k gAdd Infinity a = a gAdd a Infinity = a gAdd (Point x1 y1) (Point x2 y2) @@ -49,38 +44,30 @@ | x2 == x1 = Infinity | otherwise = Point x' y' where - l = (y2 - y1) / (x2 - x1) - x' = l^2 - x1 - x2 + l = (y2 - y1) / (x2 - x1) + x' = pow l 2 - x1 - x2 y' = -l * x' + l * x1 - y1 -- | Point doubling -gDouble :: (Fractional t, Eq t) => Point t -> Point t +gDouble :: GaloisField k => Point k -> Point k gDouble Infinity = Infinity gDouble (Point _ 0) = Infinity gDouble (Point x y) = Point x' y' where - l = 3*x^2 / (2*y) - x' = l^2 - 2*x + l = 3 * pow x 2 / (2 * y) + x' = pow l 2 - 2 * x y' = -l * x' + l * x - y -- | Negation (flipping the y component) -gNeg - :: (Fractional t, Eq t) - => Point t - -> Point t -gNeg Infinity = Infinity +gNeg :: GaloisField k => Point k -> Point k +gNeg Infinity = Infinity gNeg (Point x y) = Point x (-y) - -- | Multiplication by a scalar -gMul - :: (Eq t, Integral a, Fractional t) - => Point t - -> a - -> Point t -gMul _ 0 = Infinity -gMul pt 1 = pt +gMul :: (Integral a, GaloisField k) => Point k -> a -> Point k +gMul _ 0 = Infinity +gMul pt 1 = pt gMul pt n | n < 0 = panic "gMul: negative scalar not supported" - | even n = gMul (gDouble pt) (n `div` 2) - | otherwise = gAdd (gMul (gDouble pt) (n `div` 2)) pt + | even n = gMul (gDouble pt) (div n 2) + | otherwise = gAdd (gMul (gDouble pt) (div n 2)) pt diff --git a/src/Pairing/Serialize.hs b/src/Pairing/Serialize.hs deleted file mode 100644 --- a/src/Pairing/Serialize.hs +++ /dev/null @@ -1,105 +0,0 @@ -module Pairing.Serialize where - -import Protolude hiding (putByteString) -import Pairing.Point -import Data.ByteString.Builder -import Data.ByteString as B -import Data.Binary.Get -import Data.Binary.Put (Put, putWord8, runPut, putByteString) -import Control.Error -import Pairing.ByteRepr -import Pairing.CyclicGroup - -class ToCompressedForm a where - -- | The serialisation may fail if y cannot be obtained from x - serializeCompressed :: a -> Maybe ByteString - -class ToUncompressedForm a where - serializeUncompressed :: a -> Maybe ByteString - --- | 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 - -header :: Word8 -> Put -header n = putWord8 0 >> putWord8 n - -elementToUncompressedForm :: (ByteRepr a) => a -> Maybe LByteString -elementToUncompressedForm a = do - repr <- mkRepr a - pure $ runPut $ do - header 4 - putByteString repr - -toUncompressedForm :: (ByteRepr a) => Point a -> Maybe LByteString -toUncompressedForm (Point x y) = do - rx <- mkRepr x - ry <- mkRepr y - pure $ runPut $ do - header 4 - putByteString rx - putByteString ry -toUncompressedForm Infinity = pure $ runPut (header 1) - -toCompressedForm :: (ByteRepr a, FromX a, Eq a) => Point a -> Maybe LByteString -toCompressedForm (Point x y) = do - ny <- yFromX x True - let yform = if ny == y then 3 else 2 - rx <- mkRepr x - pure (runPut $ header yform >> putByteString rx) -toCompressedForm Infinity = Just (toLazyByteString (word8 0 <> word8 1)) - -pointFromByteString :: (Show a, Validate (Point a), ByteRepr a, FromX a) => a -> LByteString -> Either Text (Point a) -pointFromByteString a = parseBS fromByteStringGet - where - fromByteStringGet = do - ctype <- getCompressionType - processCompressed a ctype - -processCompressed :: forall a . (ByteRepr a, FromX a) => a -> Word8 -> Get (Maybe (Point a)) -processCompressed one ct - | ct == 4 = do - xbs <- getByteString rlen - ybs <- getByteString rlen - pure (buildPoint one xbs ybs) - | ct == 2 = fromCompressed False - | ct == 3 = fromCompressed True - | ct == 1 = pure (Just Infinity) - | otherwise = pure Nothing - where - rlen = reprLength one - fromCompressed largestY = runMaybeT $ do - xbs <- lift $ getByteString rlen - x <- hoistMaybe $ fromRepr one xbs - y <- hoistMaybe $ yFromX x largestY - pure (Point x y) - -buildPoint :: ByteRepr a => a -> ByteString -> ByteString -> Maybe (Point a) -buildPoint one xbs ybs = do - x <- fromRepr one xbs - y <- fromRepr one ybs - pure (Point x y) - -getCompressionType :: Get Word8 -getCompressionType = getWord8 >> getWord8 - -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 - bs <- getByteString (reprLength ele) - pure (fromRepr ele bs) - else - pure Nothing - -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" diff --git a/src/Pairing/Serialize/Jivsov.hs b/src/Pairing/Serialize/Jivsov.hs new file mode 100644 --- /dev/null +++ b/src/Pairing/Serialize/Jivsov.hs @@ -0,0 +1,117 @@ +-- | 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 ( + 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) diff --git a/src/Pairing/Serialize/MCLWasm.hs b/src/Pairing/Serialize/MCLWasm.hs new file mode 100644 --- /dev/null +++ b/src/Pairing/Serialize/MCLWasm.hs @@ -0,0 +1,64 @@ +-- | +-- 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 ( + 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" diff --git a/src/Pairing/Serialize/Types.hs b/src/Pairing/Serialize/Types.hs new file mode 100644 --- /dev/null +++ b/src/Pairing/Serialize/Types.hs @@ -0,0 +1,57 @@ +{-| +Base API for Point serialisation for G1, G2 and GT +-} + +module Pairing.Serialize.Types ( + 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" diff --git a/tests/TestCommon.hs b/tests/TestCommon.hs --- a/tests/TestCommon.hs +++ b/tests/TestCommon.hs @@ -51,4 +51,3 @@ -> Bool distributes mult add x y z = x `mult` (y `add` z) == (x `mult` y) `add` (x `mult` z) - diff --git a/tests/TestFields.hs b/tests/TestFields.hs --- a/tests/TestFields.hs +++ b/tests/TestFields.hs @@ -1,44 +1,20 @@ -{-# LANGUAGE ScopedTypeVariables #-} - module TestFields where import Protolude -import Pairing.Fq as Fq -import Pairing.Fr as Fr -import Pairing.Fq2 as Fq2 -import Pairing.Fq6 as Fq6 -import Pairing.Fq12 - +import GaloisField +import ExtensionField +import Pairing.Fq +import Pairing.Fr +import Pairing.ByteRepr import Test.Tasty -import Test.Tasty.QuickCheck import Test.Tasty.HUnit +import Test.Tasty.QuickCheck +import qualified Test.QuickCheck.Monadic as TQM (monadicIO, assert, run) import TestCommon ------------------------------------------------------------------------------- --- Generators -------------------------------------------------------------------------------- - -instance Arbitrary Fq where - arbitrary = Fq.new <$> arbitrary - -instance Arbitrary Fr where - arbitrary = Fr.new <$> arbitrary - -instance Arbitrary Fq2 where - arbitrary = Fq2 <$> arbitrary <*> arbitrary - -instance Arbitrary Fq6 where - arbitrary = Fq6 - <$> arbitrary - <*> arbitrary - <*> arbitrary - -instance Arbitrary Fq12 where - arbitrary = Fq12 <$> arbitrary <*> arbitrary - -------------------------------------------------------------------------------- -- Laws of field operations ------------------------------------------------------------------------------- @@ -53,9 +29,9 @@ $ commutes ((+) :: a -> a -> a) , testProperty "commutativity of multiplication" $ commutes ((*) :: a -> a -> a) - , testProperty "associavity of addition" + , testProperty "associativity of addition" $ associates ((+) :: a -> a -> a) - , testProperty "associavity of multiplication" + , testProperty "associativity of multiplication" $ associates ((*) :: a -> a -> a) , testProperty "additive identity" $ isIdentity ((+) :: a -> a -> a) 0 @@ -77,13 +53,6 @@ test_fieldLaws_Fq = testFieldLaws (Proxy :: Proxy Fq) "Fq" ------------------------------------------------------------------------------- --- Fr -------------------------------------------------------------------------------- - -test_fieldLaws_Fr :: TestTree -test_fieldLaws_Fr = testFieldLaws (Proxy :: Proxy Fr) "Fr" - -------------------------------------------------------------------------------- -- Fq2 ------------------------------------------------------------------------------- @@ -92,28 +61,24 @@ -- Defining property for Fq2 as an extension over Fq: u^2 = -1 unit_uRoot :: Assertion -unit_uRoot = u^2 @=? minusOne +unit_uRoot = u^2 @=? -1 where - u = Fq2.new 0 1 - minusOne = Fq2.new (-1) 0 + u = fromList [0, 1] :: Fq2 -unit_fq2pow :: Assertion -unit_fq2pow = do - fq2 <- Fq2.random - let pow5 = fq2sqr (fq2sqr fq2) * fq2 - pow5 @=? fq2pow fq2 5 - let pow10 = ((fq2sqr (fq2sqr (fq2sqr fq2))) * fq2) * fq2 - pow10 @=? fq2pow fq2 10 - where - u = Fq2.new 0 1 - minusOne = Fq2.new (-1) 0 +unit_fq2Pow :: Assertion +unit_fq2Pow = do + fq2 :: Fq2 <- rnd + let pow5 = ((fq2 ^ 2) ^ 2) * fq2 + pow5 @=? fq2 ^ 5 + let pow10 = ((((fq2 ^ 2) ^ 2) ^ 2) * fq2) * fq2 + pow10 @=? fq2 ^ 10 -unit_fq2sqrt :: Assertion -unit_fq2sqrt = do - fq2 <- Fq2.random - let sq = fq2sqr fq2 - let (Just rt) = fq2sqrt sq - sq @=? fq2sqr rt +unit_fq2Sqrt :: Assertion +unit_fq2Sqrt = do + fq2 :: Fq2 <- rnd + let sq = fq2 ^ 2 + let (Just rt) = fq2Sqrt sq + sq @=? rt ^ 2 ------------------------------------------------------------------------------- -- Fq6 @@ -124,11 +89,10 @@ -- Defining property for Fq6 as an extension over Fq2: v^3 = 9 + u unit_vRoot :: Assertion -unit_vRoot = v^3 @=? ninePlusU +unit_vRoot = v^3 @=? 9 + u where - v = Fq6.new 0 1 0 - ninePlusU = Fq6.new (Fq2.new 9 1) 0 0 - + v = fromList [0, 1] :: Fq6 + u = fromList [fromList [0, 1]] ------------------------------------------------------------------------------- -- Fq12 @@ -141,6 +105,53 @@ unit_wRoot :: Assertion unit_wRoot = w^2 @=? v where - w = Fq12 0 1 - v = Fq12 (Fq6 0 1 0) 0 + w = fromList [0, 1] :: Fq12 + v = fromList [fromList [0, 1]] +------------------------------------------------------------------------------- +-- Fr +------------------------------------------------------------------------------- + +test_fieldLaws_Fr :: TestTree +test_fieldLaws_Fr = testFieldLaws (Proxy :: Proxy Fr) "Fr" + +------------------------------------------------------------------------------- +-- Byte Representation +------------------------------------------------------------------------------- + +primeFieldByteRepresentationTest :: Fq -> Assertion +primeFieldByteRepresentationTest f = do + byteReprTest f MostSignificantFirst 32 + byteReprTest f LeastSignificantFirst 32 + byteReprTest f MostSignificantFirst 64 + byteReprTest f LeastSignificantFirst 64 + +extensionFieldByteRepresentationTest :: (Show a, Eq a, ByteRepr (ExtensionField a b)) => ExtensionField a b -> Assertion +extensionFieldByteRepresentationTest f = case fromField f of + [] -> pure () + _ -> do + byteReprTest f MostSignificantFirst 32 + byteReprTest f LeastSignificantFirst 32 + byteReprTest f MostSignificantFirst 64 + byteReprTest f LeastSignificantFirst 64 + +byteReprTest :: (Show a, Eq a, ByteRepr a) => a -> Pairing.ByteRepr.ByteOrder -> Int -> Assertion +byteReprTest f bo sz = do + let t = mkRepr (ByteOrderLength bo sz) f + assertBool ("mkRepr " <> show f) (isJust t) + let Just bs = t + let d = fromRepr (ByteOrderLength bo sz) f bs + assertBool ("fromRepr " <> show f) (isJust d) + (Just f) @=? d + +prop_fqByteRepr :: Fq -> Property +prop_fqByteRepr a = TQM.monadicIO $ TQM.run $ primeFieldByteRepresentationTest a + +prop_fq2ByteRepr :: Fq2 -> Property +prop_fq2ByteRepr a = TQM.monadicIO $ TQM.run $ extensionFieldByteRepresentationTest a + +prop_fq6ByteRepr :: Fq6 -> Property +prop_fq6ByteRepr a = TQM.monadicIO $ TQM.run $ extensionFieldByteRepresentationTest a + +prop_fq12ByteRepr :: Fq12 -> Property +prop_fq12ByteRepr a = TQM.monadicIO $ TQM.run $ extensionFieldByteRepresentationTest a diff --git a/tests/TestGroups.hs b/tests/TestGroups.hs --- a/tests/TestGroups.hs +++ b/tests/TestGroups.hs @@ -1,24 +1,26 @@ -{-# LANGUAGE FlexibleInstances #-} - module TestGroups where import Protolude -import Pairing.Fq as Fq -import Pairing.Fr as Fr -import Pairing.Fq2 -import Pairing.Fq12 -import Pairing.Point -import Pairing.Group as G -import Pairing.Params -import Pairing.Serialize +import Data.ByteString as BS (null, dropWhile) +import Pairing.Fq +import Pairing.Fr +import Pairing.Group +import Pairing.CyclicGroup import Pairing.Pairing +import Pairing.Params +import Pairing.Point +import Pairing.ByteRepr +import Pairing.Serialize.Types +import Pairing.Serialize.Jivsov +import Pairing.Serialize.MCLWasm +import ExtensionField (fromList) import Test.Tasty -import Test.Tasty.QuickCheck import Test.Tasty.HUnit +import Test.QuickCheck.Instances import qualified Test.QuickCheck.Monadic as TQM (monadicIO, assert, run) -import Test.QuickCheck.Instances () -import Data.ByteString as BS (null, dropWhile) +import Test.Tasty.QuickCheck +import Data.HexString as H import TestCommon ------------------------------------------------------------------------------- @@ -54,11 +56,11 @@ g1FromXTest :: G1 -> Assertion g1FromXTest Infinity = pure () g1FromXTest pt@(Point x y) = do - let ysq = fqPow y 2 - let (Just lysqrt) = fqSqrt True ysq - let (Just sysqrt) = fqSqrt False ysq - let egly = groupFromX True x - let egsy = groupFromX False x + let ysq = y ^ 2 + let (Just lysqrt) = fqSqrt max ysq + let (Just sysqrt) = fqSqrt max ysq + let egly = groupFromX max x + let egsy = groupFromX max x isJust egly @=? True isJust egsy @=? True let Just lyg = egly @@ -66,6 +68,12 @@ (Point x lysqrt) @=? lyg (Point x sysqrt) @=? syg +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) + ------------------------------------------------------------------------------- -- G1 ------------------------------------------------------------------------------- @@ -97,12 +105,22 @@ prop_g1FromX g = TQM.monadicIO $ do TQM.run $ g1FromXTest g -prop_g1SerializeUncomp :: G1 -> Property -prop_g1SerializeUncomp g = TQM.monadicIO $ TQM.run $ serializeTest g serializeUncompressed G.fromByteStringG1 +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_g1SerializeComp :: G1 -> Property -prop_g1SerializeComp g = TQM.monadicIO $ TQM.run $ serializeTest g serializeCompressed G.fromByteStringG1 +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 + ------------------------------------------------------------------------------- -- G2 ------------------------------------------------------------------------------- @@ -125,20 +143,32 @@ g2FromXTest :: G2 -> Assertion g2FromXTest Infinity = pure () g2FromXTest pt@(Point x y) = do - let ysq = fq2pow y 2 - let (Just ny) = fq2YforX x True + let ysq = y ^ 2 + let (Just ny) = fq2YforX x (\y1 y2 -> if isOdd y1 then y1 else y2) if (ny /= y) then (Point x y) @=? (Point x (negate ny)) else (Point x y) @=? (Point x ny) prop_g2FromX :: G2 -> Property prop_g2FromX g = TQM.monadicIO $ do TQM.run $ g2FromXTest g -prop_g2SerializeUncomp :: G2 -> Property -prop_g2SerializeUncomp g = TQM.monadicIO $ TQM.run $ serializeTest g serializeUncompressed G.fromByteStringG2 +unit_g2SerializeCompMCLWasm :: Assertion +unit_g2SerializeCompMCLWasm = do + let fq2x = fromList ([6544947162799133903546594463061476713923884516504213524167597810128866380952, 1440920261338086273401746857890494196693993714596389710801111883382590011446] :: [Fq]) :: Fq2 + let fq2y = fromList ([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_g2SerializeComp :: G2 -> Property -prop_g2SerializeComp g = TQM.monadicIO $ TQM.run $ serializeTest g serializeUncompressed G.fromByteStringG2 +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 + ------------------------------------------------------------------------------- -- GT ------------------------------------------------------------------------------- @@ -146,9 +176,7 @@ -- The group laws for GT are implied by the field tests for Fq12. gtSerializeTest :: G1 -> G2 -> Assertion -gtSerializeTest g1 g2 = do - let gt = reducedPairing g1 g2 - serializeTest gt serializeUncompressed fromByteStringGT +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 diff --git a/tests/TestPairing.hs b/tests/TestPairing.hs --- a/tests/TestPairing.hs +++ b/tests/TestPairing.hs @@ -2,38 +2,36 @@ import Protolude -import TestFields () -- for its Arbitrary instances +import ExtensionField + import Pairing.Group import Pairing.Pairing import Pairing.Point -import Pairing.Fq (Fq(..)) -import Pairing.Fq2 (Fq2(..)) -import Pairing.Fq12 (Fq12(..)) -import qualified Pairing.Fq12 as Fq12 +import Pairing.Fq import Test.QuickCheck import Test.Tasty.HUnit -- Random points in G1, G2 as generated by libff. inpG1 :: G1 inpG1 = Point - (Fq 1368015179489954701390400359078579693043519447331113978918064868415326638035) - (Fq 9918110051302171585080402603319702774565515993150576347155970296011118125764) + 1368015179489954701390400359078579693043519447331113978918064868415326638035 + 9918110051302171585080402603319702774565515993150576347155970296011118125764 inpG2 :: G2 inpG2 = Point - (Fq2 - (Fq 2725019753478801796453339367788033689375851816420509565303521482350756874229) - (Fq 7273165102799931111715871471550377909735733521218303035754523677688038059653) + (fromList + [ 2725019753478801796453339367788033689375851816420509565303521482350756874229 + , 7273165102799931111715871471550377909735733521218303035754523677688038059653 ] ) - (Fq2 - (Fq 2512659008974376214222774206987427162027254181373325676825515531566330959255) - (Fq 957874124722006818841961785324909313781880061366718538693995380805373202866) + (fromList + [ 2512659008974376214222774206987427162027254181373325676825515531566330959255 + , 957874124722006818841961785324909313781880061366718538693995380805373202866 ] ) beforeExponentiation :: Fq12 beforeExponentiation - = Fq12.new + = construct [ 10244919957345566208036224388367387294947954375520342002142038721148536068658 , 20520725903107462730350108147804326707908059028221039276493719519842949720531 , 6086095302240468555411758663466251351417777262748587710512082696159022563215 @@ -50,7 +48,7 @@ afterExponentiation :: Fq12 afterExponentiation - = Fq12.new + = construct [ 7297928317524675251652102644847406639091474940444702627333408876432772026640 , 18010865284024443253481973710158529446817119443459787454101328040744995455319 , 14179125828660221708486990054318233868908974550229474018509093903907472063156 @@ -103,7 +101,7 @@ prop :: G1 -> G2 -> Bool prop e1 e2 = or [ e1 == Infinity , e2 == Infinity - , reducedPairing e1 e2 /= Fq12.fq12one + , reducedPairing e1 e2 /= 1 ] -- Output of the pairing to the power _r should be the unit of GT. @@ -114,7 +112,7 @@ prop e1 e2 = isInGT (reducedPairing e1 e2) prop_frobeniusFq12Correct :: Fq12 -> Bool -prop_frobeniusFq12Correct f = frobeniusNaive 1 f == Fq12.fq12frobenius 1 f +prop_frobeniusFq12Correct f = frobeniusNaive 1 f == fq12Frobenius 1 f prop_finalExponentiationCorrect :: Property prop_finalExponentiationCorrect = withMaxSuccess 10 prop