bulletproofs 0.3.0 → 0.4.0

raw patch · 12 files changed

+172/−67 lines, 12 filesdep +criteriondep ~arithmoidep ~basedep ~protoludePVP ok

version bump matches the API change (PVP)

Dependencies added: criterion

Dependency ranges changed: arithmoi, base, protolude

API changes (from Hackage documentation)

Files

• Bulletproofs/ArithmeticCircuit/Internal.hs +6/−3
• Bulletproofs/ArithmeticCircuit/Prover.hs +11/−8
• Bulletproofs/ArithmeticCircuit/Verifier.hs +7/−7
• Bulletproofs/InnerProductProof/Prover.hs +24/−29
• Bulletproofs/InnerProductProof/Verifier.hs +2/−2
• Bulletproofs/MultiRangeProof/Prover.hs +7/−6
• Bulletproofs/MultiRangeProof/Verifier.hs +1/−1
• Bulletproofs/RangeProof/Internal.hs +9/−8
• Bulletproofs/Utils.hs +12/−1
• ChangeLog.md +23/−0
• bench/Main.hs +43/−0
• bulletproofs.cabal +27/−2

@@ -110,8 +110,8 @@ commitBitVector vBlinding vL vR = vLG `addP` vRH `addP` vBlindingH   where     vBlindingH = vBlinding `mulP` h-    vLG = foldl' addP Crypto.PointO ( zipWith mulP vL gs )-    vRH = foldl' addP Crypto.PointO ( zipWith mulP vR hs )+    vLG = sumExps vL gs+    vRH = sumExps vR hs  shamirGxGxG :: (Show f, Num f) => Crypto.Point -> Crypto.Point -> Crypto.Point -> f shamirGxGxG p1 p2 p3@@ -187,7 +187,10 @@  generateGateWeights :: (Crypto.MonadRandom m, Num f) => Integer -> Integer -> m (GateWeights f) generateGateWeights lConstraints n = do-  [wL, wR, wO] <- replicateM 3 ((\i -> insertAt (fromIntegral i) (oneVector n) (replicate (fromIntegral lConstraints - 1) (zeroVector n))) <$> generateMax (fromIntegral lConstraints))+  let genVec = ((\i -> insertAt (fromIntegral i) (oneVector n) (replicate (fromIntegral lConstraints - 1) (zeroVector n))) <$> generateMax (fromIntegral lConstraints))+  wL <- genVec+  wR <- genVec+  wO <- genVec   pure $ GateWeights wL wR wO   where     zeroVector x = replicate (fromIntegral x) 0

@@ -23,8 +23,11 @@   -> m (ArithCircuitProof f) generateProof (padCircuit -> ArithCircuit{..}) ArithWitness{..} = do   let GateWeights{..} = weights-  let Assignment{..} = padAssignment assignment-  [aiBlinding, aoBlinding, sBlinding] <- replicateM 3 ((fromInteger :: Integer -> f) <$> generateMax q)+      Assignment{..} = padAssignment assignment+      genBlinding = (fromInteger :: Integer -> f) <$> generateMax q+  aiBlinding <- genBlinding+  aoBlinding <- genBlinding+  sBlinding <- genBlinding   let n = fromIntegral $ length aL       aiCommit = commitBitVector aiBlinding aL aR  -- commitment to aL, aR       aoCommit = commitBitVector aoBlinding aO []  -- commitment to aO@@ -42,7 +45,7 @@       zwO = zs `vectorMatrixProduct` wO        -- Polynomials-      [lPoly, rPoly] = computePolynomials n aL aR aO sL sR y zwL zwR zwO+      (lPoly, rPoly) = computePolynomials n aL aR aO sL sR y zwL zwR zwO       tPoly = multiplyPoly lPoly rPoly        w = (aL `vectorMatrixProductT` wL)@@ -58,7 +61,7 @@   let tCommits = zipWith commit tPoly tBlindings    let x = shamirGs tCommits-      evalTCommit = foldl' addP Crypto.PointO (zipWith mulP (powerVector x 7) tCommits)+      evalTCommit = sumExps (powerVector x 7) tCommits    let ls = evaluatePolynomial n lPoly x       rs = evaluatePolynomial n rPoly x@@ -79,8 +82,8 @@       commitmentLR = (x `mulP` aiCommit)                    `addP` (fSquare x `mulP` aoCommit)                    `addP` ((x ^ 3)`mulP` sCommit)-                   `addP` foldl' addP Crypto.PointO (zipWith mulP gExp gs)-                   `addP` foldl' addP Crypto.PointO (zipWith mulP hExp hs')+                   `addP` sumExps gExp gs+                   `addP` sumExps hExp hs'                    `addP` Crypto.pointNegate curve (mu `mulP` h)                    `addP` (t `mulP` u) @@ -102,9 +105,9 @@   where     qLen = fromIntegral $ length commitmentWeights     computePolynomials n aL aR aO sL sR y zwL zwR zwO-      = [ [l0, l1, l2, l3]+      = ( [l0, l1, l2, l3]         , [r0, r1, r2, r3]-        ]+        )       where         l0 = replicate (fromIntegral n) 0         l1 = aL ^+^ (powerVector (recip y) n `hadamardp` zwR)

@@ -41,9 +41,9 @@      hs' = zipWith mulP (powerVector (recip y) n) hs -    wLCommit = foldl' addP Crypto.PointO (zipWith mulP (zs `vectorMatrixProduct` wL) hs')-    wRCommit = foldl' addP Crypto.PointO (zipWith mulP wRExp gs)-    wOCommit = foldl' addP Crypto.PointO (zipWith mulP (zs `vectorMatrixProduct` wO) hs')+    wLCommit = sumExps (zs `vectorMatrixProduct` wL) hs'+    wRCommit = sumExps wRExp gs+    wOCommit = sumExps (zs `vectorMatrixProduct` wO) hs'     wRExp = powerVector (recip y) n `hadamardp` (zs `vectorMatrixProduct` wL)      uChallenge = shamirU tBlinding mu t@@ -54,13 +54,13 @@         lhs = commit t tBlinding         rhs = (gExp `mulP` g)             `addP` tCommitsExpSum-            `addP` foldl' addP Crypto.PointO ( zipWith mulP vExp vCommits )+            `addP` sumExps vExp vCommits         gExp = fSquare x * (k + cQ)         cQ = zs `dot` cs         vExp = (*) (fSquare x) <$> (zs `vectorMatrixProduct` commitmentWeights)         k = delta n y zwL zwR         xs = 0 : x : 0 : (((^) x) <$> [3..6])-        tCommitsExpSum = foldl' addP Crypto.PointO (zipWith mulP xs tCommits)+        tCommitsExpSum = sumExps xs tCommits      verifyLRCommitment       = IPP.verifyProof@@ -74,7 +74,7 @@         commitmentLR = (x `mulP` aiCommit)                      `addP` (fSquare x `mulP` aoCommit)                      `addP` ((x ^ 3) `mulP` sCommit)-                     `addP` foldl' addP Crypto.PointO (zipWith mulP gExp gs)-                     `addP` foldl' addP Crypto.PointO (zipWith mulP hExp hs')+                     `addP` sumExps gExp gs+                     `addP` sumExps hExp hs'                      `addP` Crypto.pointNegate curve (mu `mulP` h)                      `addP` (t `mulP` u)

@@ -6,6 +6,7 @@  import Protolude +import Control.Exception (assert) import qualified Data.List as L import qualified Data.Map as Map @@ -47,17 +48,13 @@   = case (ls, rs) of     ([], [])   -> InnerProductProof [] [] 0 0     ([l], [r]) -> InnerProductProof (reverse lCommits) (reverse rCommits) l r-    _          -> if | not checkLGs -> panic "Error in: l' * Gs' == l * Gs + x^2 * A_L + x^(-2) * A_R"-                     | not checkRHs -> panic "Error in: r' * Hs' == r * Hs + x^2 * B_L + x^(-2) * B_R"-                     | not checkLBs -> panic "Error in: l' * r' == l * r + x^2 * (lsLeft * rsRight) + x^-2 * (lsRight * rsLeft)"-                     | not checkC -> panic "Error in: C == zG + aG + bH'"-                     | not checkC' -> panic "Error in: C' = C + x^2 L + x^-2 R == z'G + a'G + b'H'"-                     | otherwise -> generateProof'-                         InnerProductBase { bGs = gs'', bHs = hs'', bH = bH }-                         commitmentLR'-                         InnerProductWitness { ls = ls', rs = rs' }-                         (lCommit:lCommits)-                         (rCommit:rCommits)+    _          -> assert (checkLGs && checkRHs && checkLBs && checkC && checkC')+                $ generateProof'+                    InnerProductBase { bGs = gs'', bHs = hs'', bH = bH }+                    commitmentLR'+                    InnerProductWitness { ls = ls', rs = rs' }+                    (lCommit:lCommits)+                    (rCommit:rCommits)   where     n' = fromIntegral $ length ls     nPrime = n' `div` 2@@ -70,15 +67,15 @@     cL = dot lsLeft rsRight     cR = dot lsRight rsLeft -    lCommit = foldl' addP Crypto.PointO (zipWith mulP lsLeft gsRight)+    lCommit = sumExps lsLeft gsRight          `addP`-         foldl' addP Crypto.PointO (zipWith mulP rsRight hsLeft)+         sumExps rsRight hsLeft          `addP`          (cL `mulP` bH) -    rCommit = foldl' addP Crypto.PointO (zipWith mulP lsRight gsLeft)+    rCommit = sumExps lsRight gsLeft          `addP`-         foldl' addP Crypto.PointO (zipWith mulP rsLeft hsRight)+         sumExps rsLeft hsRight          `addP`          (cR `mulP` bH) @@ -88,8 +85,8 @@     xs = replicate nPrime x     xsInv = replicate nPrime xInv -    gs'' = zipWith addP (zipWith mulP xsInv gsLeft) (zipWith mulP xs gsRight)-    hs'' = zipWith addP (zipWith mulP xs hsLeft) (zipWith mulP xsInv hsRight)+    gs'' = zipWith (\(exp0, pt0) (exp1, pt1) -> addTwoMulP exp0 pt0 exp1 pt1) (zip xsInv gsLeft) (zip xs gsRight)+    hs'' = zipWith (\(exp0, pt0) (exp1, pt1) -> addTwoMulP exp0 pt0 exp1 pt1) (zip xs hsLeft) (zip xsInv hsRight)      ls' = ((*) x <$> lsLeft) ^+^ ((*) xInv <$> lsRight)     rs' = ((*) xInv <$> rsLeft) ^+^ ((*) x <$> rsRight)@@ -105,25 +102,25 @@     -- Checks     ----------------------------- -    aL' = foldl' addP Crypto.PointO (zipWith mulP lsLeft gsRight)-    aR' = foldl' addP Crypto.PointO (zipWith mulP lsRight gsLeft)+    aL' = sumExps lsLeft gsRight+    aR' = sumExps lsRight gsLeft -    bL' = foldl' addP Crypto.PointO (zipWith mulP rsLeft hsRight)-    bR' = foldl' addP Crypto.PointO (zipWith mulP rsRight hsLeft)+    bL' = sumExps rsLeft hsRight+    bR' = sumExps rsRight hsLeft      z = dot ls rs     z' = dot ls' rs' -    lGs = foldl' addP Crypto.PointO (zipWith mulP ls bGs)-    rHs = foldl' addP Crypto.PointO (zipWith mulP rs bHs)+    lGs = sumExps ls bGs+    rHs = sumExps rs bHs -    lGs' = foldl' addP Crypto.PointO (zipWith mulP ls' gs'')-    rHs' = foldl' addP Crypto.PointO (zipWith mulP rs' hs'')+    lGs' = sumExps ls' gs''+    rHs' = sumExps rs' hs''      checkLGs       = lGs'         ==-        foldl' addP Crypto.PointO (zipWith mulP ls bGs)+        sumExps ls bGs         `addP`         (fSquare x `mulP` aL')         `addP`@@ -132,7 +129,7 @@     checkRHs       = rHs'         ==-        foldl' addP Crypto.PointO (zipWith mulP rs bHs)+        sumExps rs bHs         `addP`         (fSquare x `mulP` bR')         `addP`@@ -160,5 +157,3 @@         lGs'         `addP`         rHs'--

@@ -37,8 +37,8 @@         `addP`         ((l * r) `mulP` bH) -    gsCommit = foldl' addP Crypto.PointO (zipWith mulP otherExponents bGs)-    hsCommit = foldl' addP Crypto.PointO (zipWith mulP (reverse otherExponents) bHs)+    gsCommit = sumExps otherExponents bGs+    hsCommit = sumExps (reverse otherExponents) bHs  mkChallenges :: (AsInteger f, Field f) => InnerProductProof f -> Crypto.Point -> ([f], [f], Crypto.Point) mkChallenges InnerProductProof{ lCommits, rCommits } commitmentLR

@@ -20,7 +20,7 @@ import Bulletproofs.InnerProductProof as IPP hiding (generateProof) import qualified Bulletproofs.InnerProductProof as IPP --- | Prove that a list of values lie in a specific range+-- | Prove that a list of values lies in a specific range generateProof   :: (AsInteger f, Eq f, Field f, Show f, MonadRandom m)   => Integer                -- ^ Upper bound of the range we want to prove@@ -74,9 +74,11 @@    (sL, sR) <- chooseBlindingVectors nm -  [aBlinding, sBlinding]-    <- replicateM 2 ((fromInteger :: Integer -> f) <$> generateMax q)+  let genBlinding = (fromInteger :: Integer -> f) <$> generateMax q +  aBlinding <- genBlinding+  sBlinding <- genBlinding+   (aCommit, sCommit) <- commitBitVectors aBlinding sBlinding aL aR sL sR    -- Oracle generates y, z from a, c@@ -86,9 +88,8 @@   let lrPoly@LRPolys{..} = computeLRPolys n m aL aR sL sR y z       tPoly@TPoly{..} = computeTPoly lrPoly -  [t1Blinding, t2Blinding]-    <- replicateM 2 ((fromInteger :: Integer -> f) <$> generateMax q)-+  t1Blinding <- genBlinding+  t2Blinding <- genBlinding    let t1Commit = commit t1 t1Blinding       t2Commit = commit t2 t2Blinding

@@ -63,7 +63,7 @@     m = fromIntegral $ length vCommits     lhs = commit t tBlinding     rhs =-          foldl' addP Crypto.PointO ( zipWith mulP ((*) (fSquare z) <$> powerVector z m) vCommits )+          sumExps ((*) (fSquare z) <$> powerVector z m) vCommits           `addP`           (delta n m y z `mulP` g)           `addP`

@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} module Bulletproofs.RangeProof.Internal where  import Protolude@@ -37,14 +38,14 @@     , productProof :: InnerProductProof f     -- ^ Inner product argument to prove that a commitment P     -- has vectors l, r ∈  Z^n for which P = l · G + r · H + ( l, r ) · U-    } deriving (Show, Eq)+    } deriving (Show, Eq, Generic, NFData)  data RangeProofError   = UpperBoundTooLarge Integer  -- ^ The upper bound of the range is too large   | ValueNotInRange Integer     -- ^ Value is not within the range required   | ValuesNotInRange [Integer]  -- ^ Values are not within the range required   | NNotPowerOf2 Integer        -- ^ Dimension n is required to be a power of 2-  deriving (Show, Eq)+  deriving (Show, Eq, Generic, NFData)  ----------------------------- -- Polynomials@@ -136,10 +137,10 @@   -> [f]   -> m (Crypto.Point, Crypto.Point) commitBitVectors aBlinding sBlinding aL aR sL sR = do-    let aLG = foldl' addP Crypto.PointO ( zipWith mulP aL gs )-        aRH = foldl' addP Crypto.PointO ( zipWith mulP aR hs )-        sLG = foldl' addP Crypto.PointO ( zipWith mulP sL gs )-        sRH = foldl' addP Crypto.PointO ( zipWith mulP sR hs )+    let aLG = sumExps aL gs+        aRH = sumExps aR hs+        sLG = sumExps sL gs+        sRH = sumExps sR hs         aBlindingH = mulP aBlinding h         sBlindingH = mulP sBlinding h @@ -190,10 +191,10 @@     `addP`     Crypto.pointNegate curve (z `mulP` gsSum)             -- (- zG)     `addP`-    foldl' addP Crypto.PointO (zipWith mulP hExp hs')     -- (hExp Hs')+    sumExps hExp hs'     -- (hExp Hs')     `addP`     foldl'-      (\acc j -> acc `addP` foldl' addP Crypto.PointO (zipWith mulP (hExp' j) (sliceHs' j)))+      (\acc j -> acc `addP` sumExps (hExp' j) (sliceHs' j))       Crypto.PointO       [1..m]     `addP`

@@ -58,10 +58,21 @@ mulP :: AsInteger f => f -> Crypto.Point -> Crypto.Point mulP x = Crypto.pointMul curve (asInteger x) +-- | Double exponentiation (Shamir's trick): g0^x0 + g1^x1+addTwoMulP :: AsInteger f => f -> Crypto.Point -> f -> Crypto.Point -> Crypto.Point+addTwoMulP exp0 pt0 exp1 pt1 = Crypto.pointAddTwoMuls curve (asInteger exp0) pt0 (asInteger exp1) pt1++-- | Raise every point to the corresponding exponent, sum up results+sumExps :: AsInteger f => [f] -> [Crypto.Point] -> Crypto.Point+sumExps (exp0:exp1:exps) (pt0:pt1:pts)+  = addTwoMulP exp0 pt0 exp1 pt1 `addP` sumExps exps pts+sumExps (exp:_) (pt:_) = mulP exp pt -- this also catches cases where either list is longer than the other+sumExps _ _ = Crypto.PointO  -- this catches cases where either list is empty+ -- | Create a Pedersen commitment to a value given -- a value and a blinding factor commit :: AsInteger f => f -> f -> Crypto.Point-commit x r = (x `mulP` g) `addP` (r `mulP` h)+commit x r = addTwoMulP x g r h  isLogBase2 :: Integer -> Bool isLogBase2 x

@@ -3,3 +3,26 @@ ## 0.1  * Initial release.+* Implementation of the Bulletproofs protocol for range proofs+* Use of the improved inner-product argument to reduce the communication complexity+* Support for SECp256k1 curve++## 0.2++* Prove and verify computations of arithmetic circuits using Bulletproofs+  protocol.+* Extend range proofs with support for multi-range proofs.+* Add documentation and provide examples to explain and use arithmetic circuits.+* Provide examples for using aggregated range proofs.+* Add multi-range proofs documentation.++## 0.3++* Update dependencies++## 0.4++* Use double exponentiation to improve performance.+* Use Control.Exception.assert to make sure debugging assertions are not checked+  when compiled with optimisations.+* Add benchmarks for rangeproofs.

@@ -0,0 +1,43 @@+{-# LANGUAGE NoImplicitPrelude #-}++-- To run this, run "stack bench"++module Main where++import Protolude++import Criterion.Main+import qualified Crypto.PubKey.ECC.Types as Crypto+import qualified Bulletproofs.RangeProof as RP+import qualified Bulletproofs.Utils as Utils+import qualified Bulletproofs.Fq as Fq++upperBound :: Integer+upperBound = 2 ^ (2 ^ 6)++benchInput :: (Integer, Integer)+benchInput = (7238283, 827361)++proof :: (Integer, Integer) -> IO (RP.RangeProof Fq.Fq)+proof input = do+  Right proof <- runExceptT $ RP.generateProof upperBound input+  pure proof++prepareProof :: IO (Crypto.Point, RP.RangeProof Fq.Fq)+prepareProof = do+  proofObj <- proof benchInput+  let cm = Utils.commit (fst benchInput) (snd benchInput)+  pure (cm, proofObj)++verify :: Crypto.Point -> RP.RangeProof Fq.Fq -> Bool+verify = RP.verifyProof upperBound++rangeproofBenchmarks :: [Benchmark]+rangeproofBenchmarks+  = [ bench "Proving" $ nfAppIO proof benchInput+    , env prepareProof $ \ ~(cm, proofObj) -> bench "Verifying" $ nf (uncurry verify) (cm, proofObj)+    ]++main :: IO ()+main = defaultMain+  [ bgroup "Rangeproof" rangeproofBenchmarks ]

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 3cc8d96dc71be213e360a7402cd170482c94bcd862ac5cfeb4687ac2726aa53f+-- hash: 45ba76c7c1825f4c36913fb81f9c8f6c9691748248208ec2ff4d1bbb54c9a836  name:           bulletproofs-version:        0.3.0+version:        0.4.0 description:    Please see the README on GitHub at <https://github.com/adjoint-io/bulletproofs#readme> category:       Cryptography homepage:       https://github.com/adjoint-io/bulletproofs#readme@@ -85,6 +85,31 @@     , random-shuffle     , tasty     , tasty-discover+    , tasty-hunit+    , tasty-quickcheck+    , text+  default-language: Haskell2010++benchmark rangeproof-benchmarks+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Paths_bulletproofs+  hs-source-dirs:+      bench+  build-depends:+      MonadRandom+    , QuickCheck+    , arithmoi+    , base >=4.7 && <5+    , bulletproofs+    , containers+    , criterion >=1.5.1.0+    , cryptonite+    , memory+    , protolude >=0.2+    , random-shuffle+    , tasty     , tasty-hunit     , tasty-quickcheck     , text