Double exponentiation optimisation (#13)

* Benchmark and profile rangeproofs

* Use `Control.Exception.assert` in order for debugging assertions to be optimised away

* Use double exponentiation in various places

* Ignore some files

* Replace refutable patterns with irrefutable patterns

Author: gdijkstra

.gitignore

@@ -2,3 +2,8 @@
 .stack-work/
 bulletproofs.cabal
 *~
+*.hi
+*.o
+*.prof
+*.prof.html
+Rangeproof

Bulletproofs/ArithmeticCircuit/Internal.hs

@@ -4,7 +4,6 @@
 module Bulletproofs.ArithmeticCircuit.Internal where
 
 import Protolude hiding (head)
-import Control.Monad.Fail
 import Data.List (head)
 import qualified Data.List as List
 import qualified Data.Map as Map
@@ -111,8 +110,8 @@ commitBitVector :: (AsInteger f) => f -> [f] -> [f] -> Crypto.Point
 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
@@ -186,9 +185,12 @@ generateWv lConstraints m
   | lConstraints < m = panic "Number of constraints must be bigger than m"
   | otherwise = shuffleM (genIdenMatrix m ++ genZeroMatrix (lConstraints - m) m)
 
-generateGateWeights :: (Crypto.MonadRandom m, Num f, MonadFail m) => Integer -> Integer -> m (GateWeights f)
+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

Bulletproofs/ArithmeticCircuit/Prover.hs

@@ -3,7 +3,6 @@ module Bulletproofs.ArithmeticCircuit.Prover where
 
 import Protolude
 
-import Control.Monad.Fail
 import Crypto.Random.Types (MonadRandom(..))
 import Crypto.Number.Generate (generateMax)
 import qualified Crypto.PubKey.ECC.Prim as Crypto
@@ -18,14 +17,17 @@ import Bulletproofs.ArithmeticCircuit.Internal
 -- for an arithmetic circuit with a valid witness
 generateProof
   :: forall f m
-   . (MonadRandom m, MonadFail m, AsInteger f, Field f, Show f, Eq f)
+   . (MonadRandom m, AsInteger f, Field f, Show f, Eq f)
   => ArithCircuit f
   -> ArithWitness f
   -> 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
@@ -43,7 +45,7 @@ generateProof (padCircuit -> ArithCircuit{..}) ArithWitness{..} = do
       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)
@@ -59,7 +61,7 @@ generateProof (padCircuit -> ArithCircuit{..}) ArithWitness{..} = do
   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
@@ -80,8 +82,8 @@ generateProof (padCircuit -> ArithCircuit{..}) ArithWitness{..} = do
       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)
 
@@ -103,9 +105,9 @@ generateProof (padCircuit -> ArithCircuit{..}) ArithWitness{..} = do
   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)

Bulletproofs/ArithmeticCircuit/Verifier.hs

@@ -41,9 +41,9 @@ verifyProof vCommits proof@ArithCircuitProof{..} (padCircuit -> ArithCircuit{..}
 
     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 @@ verifyProof vCommits proof@ArithCircuitProof{..} (padCircuit -> ArithCircuit{..}
         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 @@ verifyProof vCommits proof@ArithCircuitProof{..} (padCircuit -> ArithCircuit{..}
         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)

Bulletproofs/InnerProductProof/Prover.hs

@@ -6,6 +6,7 @@ module Bulletproofs.InnerProductProof.Prover (
 
 import Protolude
 
+import Control.Exception (assert)
 import qualified Data.List as L
 import qualified Data.Map as Map
 
@@ -47,17 +48,13 @@ generateProof'
   = 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 @@ generateProof'
     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 @@ generateProof'
     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 @@ generateProof'
     -- 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 @@ generateProof'
     checkRHs
       = rHs'
         ==
-        foldl' addP Crypto.PointO (zipWith mulP rs bHs)
+        sumExps rs bHs
         `addP`
         (fSquare x `mulP` bR')
         `addP`
@@ -160,5 +157,3 @@ generateProof'
         lGs'
         `addP`
         rHs'
-
-

Bulletproofs/InnerProductProof/Verifier.hs

@@ -37,8 +37,8 @@ verifyProof n productBase@InnerProductBase{..} commitmentLR productProof@InnerPr
         `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

Bulletproofs/MultiRangeProof/Prover.hs

@@ -7,7 +7,6 @@ module Bulletproofs.MultiRangeProof.Prover (
 
 import Protolude
 
-import Control.Monad.Fail
 import Crypto.Random.Types (MonadRandom(..))
 import Crypto.Number.Generate (generateMax)
 import qualified Crypto.PubKey.ECC.Generate as Crypto
@@ -23,7 +22,7 @@ import qualified Bulletproofs.InnerProductProof as IPP
 
 -- | Prove that a list of values lies in a specific range
 generateProof
-  :: (AsInteger f, Eq f, Field f, Show f, MonadRandom m, MonadFail m)
+  :: (AsInteger f, Eq f, Field f, Show f, MonadRandom m)
   => Integer                -- ^ Upper bound of the range we want to prove
   -> [(Integer, Integer)]
   -- ^ Values we want to prove in range and their blinding factors
@@ -54,7 +53,7 @@ generateProof upperBound vsAndvBlindings = do
 -- | Generate range proof from valid inputs
 generateProofUnsafe
   :: forall f m
-   . (AsInteger f, Eq f, Field f, Show f, MonadRandom m, MonadFail m)
+   . (AsInteger f, Eq f, Field f, Show f, MonadRandom m)
   => Integer    -- ^ Upper bound of the range we want to prove
   -> [(Integer, Integer)]
   -- ^ Values we want to prove in range and their blinding factors
@@ -75,8 +74,10 @@ generateProofUnsafe upperBound vsAndvBlindings = do
 
   (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
 
@@ -87,9 +88,8 @@ generateProofUnsafe upperBound vsAndvBlindings = do
   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

Bulletproofs/MultiRangeProof/Verifier.hs

@@ -63,7 +63,7 @@ verifyTPoly n vCommits proof@RangeProof{..} x y z
     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`

Bulletproofs/RangeProof/Internal.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
 module Bulletproofs.RangeProof.Internal where
 
 import Protolude
@@ -37,14 +38,14 @@ data RangeProof f
     , 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 @@ commitBitVectors
   -> [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 @@ computeLRCommitment n m aCommit sCommit t tBlinding mu x y z hs'
     `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`