diff --git a/Bulletproofs/ArithmeticCircuit/Internal.hs b/Bulletproofs/ArithmeticCircuit/Internal.hs --- a/Bulletproofs/ArithmeticCircuit/Internal.hs +++ b/Bulletproofs/ArithmeticCircuit/Internal.hs @@ -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 diff --git a/Bulletproofs/ArithmeticCircuit/Prover.hs b/Bulletproofs/ArithmeticCircuit/Prover.hs --- a/Bulletproofs/ArithmeticCircuit/Prover.hs +++ b/Bulletproofs/ArithmeticCircuit/Prover.hs @@ -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) diff --git a/Bulletproofs/ArithmeticCircuit/Verifier.hs b/Bulletproofs/ArithmeticCircuit/Verifier.hs --- a/Bulletproofs/ArithmeticCircuit/Verifier.hs +++ b/Bulletproofs/ArithmeticCircuit/Verifier.hs @@ -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) diff --git a/Bulletproofs/InnerProductProof/Prover.hs b/Bulletproofs/InnerProductProof/Prover.hs --- a/Bulletproofs/InnerProductProof/Prover.hs +++ b/Bulletproofs/InnerProductProof/Prover.hs @@ -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' - - diff --git a/Bulletproofs/InnerProductProof/Verifier.hs b/Bulletproofs/InnerProductProof/Verifier.hs --- a/Bulletproofs/InnerProductProof/Verifier.hs +++ b/Bulletproofs/InnerProductProof/Verifier.hs @@ -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 diff --git a/Bulletproofs/MultiRangeProof/Prover.hs b/Bulletproofs/MultiRangeProof/Prover.hs --- a/Bulletproofs/MultiRangeProof/Prover.hs +++ b/Bulletproofs/MultiRangeProof/Prover.hs @@ -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 diff --git a/Bulletproofs/MultiRangeProof/Verifier.hs b/Bulletproofs/MultiRangeProof/Verifier.hs --- a/Bulletproofs/MultiRangeProof/Verifier.hs +++ b/Bulletproofs/MultiRangeProof/Verifier.hs @@ -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` diff --git a/Bulletproofs/RangeProof/Internal.hs b/Bulletproofs/RangeProof/Internal.hs --- a/Bulletproofs/RangeProof/Internal.hs +++ b/Bulletproofs/RangeProof/Internal.hs @@ -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` diff --git a/Bulletproofs/Utils.hs b/Bulletproofs/Utils.hs --- a/Bulletproofs/Utils.hs +++ b/Bulletproofs/Utils.hs @@ -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 diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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. diff --git a/bench/Main.hs b/bench/Main.hs new file mode 100644 --- /dev/null +++ b/bench/Main.hs @@ -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 ] diff --git a/bulletproofs.cabal b/bulletproofs.cabal --- a/bulletproofs.cabal +++ b/bulletproofs.cabal @@ -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 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