pairing 0.3.1 → 0.4.1
raw patch · 27 files changed
+1119/−1349 lines, 27 filesdep +MonadRandomdep +galois-fielddep +hexstringdep −cryptonitedep −pairingdep ~arithmoidep ~basedep ~protolude
Dependencies added: MonadRandom, galois-field, hexstring
Dependencies removed: cryptonite, pairing
Dependency ranges changed: arithmoi, base, protolude
Files
- ChangeLog.md +15/−0
- README.md +3/−1
- bench/BenchPairing.hs +176/−184
- bench/Main.hs +0/−2
- pairing.cabal +45/−36
- src/Pairing/ByteRepr.hs +51/−32
- src/Pairing/CyclicGroup.hs +13/−9
- src/Pairing/Fq.hs +242/−95
- src/Pairing/Fq12.hs +0/−153
- src/Pairing/Fq2.hs +0/−192
- src/Pairing/Fq6.hs +0/−126
- src/Pairing/Fr.hs +26/−89
- src/Pairing/Group.hs +62/−93
- src/Pairing/Hash.hs +12/−10
- src/Pairing/Jacobian.hs +15/−17
- src/Pairing/Modular.hs +8/−10
- src/Pairing/Pairing.hs +29/−34
- src/Pairing/Params.hs +10/−10
- src/Pairing/Point.hs +24/−37
- src/Pairing/Serialize.hs +0/−105
- src/Pairing/Serialize/Jivsov.hs +117/−0
- src/Pairing/Serialize/MCLWasm.hs +64/−0
- src/Pairing/Serialize/Types.hs +57/−0
- tests/TestCommon.hs +0/−1
- tests/TestFields.hs +76/−65
- tests/TestGroups.hs +59/−31
- tests/TestPairing.hs +15/−17
ChangeLog.md view
@@ -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
README.md view
@@ -1,5 +1,7 @@ <p align="center">- <a href="http://www.adjoint.io"><img src="https://www.adjoint.io/assets/img/adjoint-logo@2x.png" width="250"/></a>+<a href="https://www.adjoint.io">+ <img width="250" src="./.assets/adjoint.png" alt="Adjoint Logo" />+</a> </p> [](https://circleci.com/gh/adjoint-io/pairing)
bench/BenchPairing.hs view
@@ -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)+ ]+ ]
bench/Main.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-}- -- To get the benchmarking data, run "stack bench". module Main where
pairing.cabal view
@@ -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
src/Pairing/ByteRepr.hs view
@@ -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
src/Pairing/CyclicGroup.hs view
@@ -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-
src/Pairing/Fq.hs view
@@ -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]/<f(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]/<g(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]/<h(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
− src/Pairing/Fq12.hs
@@ -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)
− src/Pairing/Fq2.hs
@@ -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----
− src/Pairing/Fq6.hs
@@ -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)
src/Pairing/Fr.hs view
@@ -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
src/Pairing/Group.hs view
@@ -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
src/Pairing/Hash.hs view
@@ -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'))
src/Pairing/Jacobian.hs view
@@ -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))
src/Pairing/Modular.hs view
@@ -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)
src/Pairing/Pairing.hs view
@@ -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))
src/Pairing/Params.hs view
@@ -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
src/Pairing/Point.hs view
@@ -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
− src/Pairing/Serialize.hs
@@ -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"
+ src/Pairing/Serialize/Jivsov.hs view
@@ -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)
+ src/Pairing/Serialize/MCLWasm.hs view
@@ -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"
+ src/Pairing/Serialize/Types.hs view
@@ -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"
tests/TestCommon.hs view
@@ -51,4 +51,3 @@ -> Bool distributes mult add x y z = x `mult` (y `add` z) == (x `mult` y) `add` (x `mult` z)-
tests/TestFields.hs view
@@ -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
tests/TestGroups.hs view
@@ -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
tests/TestPairing.hs view
@@ -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