bulletproofs 1.0.1 → 1.1.0

raw patch · 33 files changed

+1264/−1173 lines, 33 filesdep +SHAdep +bytestringdep +elliptic-curvedep −random-shuffledep ~arithmoidep ~galois-fieldnew-component:exe:bulletproofs-examplePVP ok

version bump matches the API change (PVP)

Dependencies added: SHA, bytestring, elliptic-curve

Dependencies removed: random-shuffle

Dependency ranges changed: arithmoi, galois-field

API changes (from Hackage documentation)

Files

• Bulletproofs/ArithmeticCircuit/Internal.hs +34/−43
• Bulletproofs/ArithmeticCircuit/Prover.hs +25/−29
• Bulletproofs/ArithmeticCircuit/Verifier.hs +17/−27
• Bulletproofs/Curve.hs +0/−109
• Bulletproofs/Fq.hs +0/−18
• Bulletproofs/InnerProductProof/Internal.hs +7/−9
• Bulletproofs/InnerProductProof/Prover.hs +35/−43
• Bulletproofs/InnerProductProof/Verifier.hs +17/−22
• Bulletproofs/MultiRangeProof/Prover.hs +25/−34
• Bulletproofs/MultiRangeProof/Verifier.hs +24/−33
• Bulletproofs/RangeProof/Internal.hs +58/−64
• Bulletproofs/RangeProof/Prover.hs +8/−8
• Bulletproofs/RangeProof/Verifier.hs +15/−22
• Bulletproofs/Utils.hs +81/−62
• ChangeLog.md +5/−0
• README.md +24/−24
• bench/Bench/ArithCircuit.hs +107/−0
• bench/Bench/RangeProof.hs +37/−0
• bench/Main.hs +5/−33
• bulletproofs.cabal +55/−21
• example/Example/ArithmeticCircuit.hs +68/−0
• example/Example/RangeProof.hs +50/−0
• example/Main.hs +11/−0
• test/Main.hs +1/−0
• test/Test/Common.hs +53/−0
• test/Test/Field.hs +71/−0
• test/Test/Protocol/ArithCircuit.hs +208/−0
• test/Test/Protocol/RangeProof.hs +223/−0
• tests/TestArithCircuitProtocol.hs +0/−220
• tests/TestCommon.hs +0/−53
• tests/TestDriver.hs +0/−1
• tests/TestField.hs +0/−63
• tests/TestProtocol.hs +0/−235

@@ -8,18 +8,9 @@ import qualified Data.List as List import qualified Data.Map as Map import Test.QuickCheck-import PrimeField (PrimeField(..), toInt)--import System.Random.Shuffle (shuffleM)-import qualified Crypto.Random.Types as Crypto (MonadRandom(..))-import Crypto.Number.Generate (generateMax, generateBetween)-import Control.Monad.Random (MonadRandom)-import qualified Crypto.PubKey.ECC.Types as Crypto-import qualified Crypto.PubKey.ECC.Prim as Crypto+import Data.Curve.Weierstrass.SECP256K1 (PA, Fr, _r, mul) -import Bulletproofs.Curve import Bulletproofs.Utils-import Bulletproofs.RangeProof import qualified Bulletproofs.InnerProductProof as IPP  data ArithCircuitProofError@@ -27,7 +18,7 @@   | NNotPowerOf2 Integer  -- ^ The number of gates is not a power of 2   deriving (Show, Eq) -data ArithCircuitProof f+data ArithCircuitProof f p   = ArithCircuitProof     { tBlinding :: f     -- ^ Blinding factor of the T1 and T2 commitments,@@ -37,15 +28,15 @@     , t :: f     -- ^ Dot product of vectors l and r that prove knowledge of the value in range     -- t = t(x) = l(x) · r(x)-    , aiCommit :: Crypto.Point+    , aiCommit :: p     -- ^ Commitment to vectors aL and aR-    , aoCommit :: Crypto.Point+    , aoCommit :: p     -- ^ Commitment to vectors aO-    , sCommit :: Crypto.Point+    , sCommit :: p     -- ^ Commitment to new vectors sL, sR, created at random by the Prover-    , tCommits :: [Crypto.Point]+    , tCommits :: [p]     -- ^ Commitments to t1, t3, t4, t5, t6-    , productProof :: IPP.InnerProductProof f+    , productProof :: IPP.InnerProductProof f p     } deriving (Show, Eq, Generic, NFData)  data ArithCircuit f@@ -66,10 +57,10 @@     , wO :: [[f]] -- ^ WO ∈ F^(Q x n)     } deriving (Show, Eq, Generic, NFData) -data ArithWitness f+data ArithWitness f p   = ArithWitness   { assignment :: Assignment f -- ^ Vectors of left and right inputs and vector of outputs-  , commitments :: [Crypto.Point] -- ^ Vector of commited input values ∈ F^m+  , commitments :: [p] -- ^ Vector of commited input values ∈ F^m   , commitBlinders :: [f] -- ^ Vector of blinding factors for input values ∈ F^m   } deriving (Show, Eq, Generic, NFData) @@ -105,25 +96,25 @@     aRNew = padToNearestPowerOfTwo aR     aONew = padToNearestPowerOfTwo aO -delta :: (KnownNat p) => Integer -> PrimeField p -> [PrimeField p] -> [PrimeField p] -> PrimeField p-delta n y zwL zwR= (powerVector (recip y) n `hadamardp` zwR) `dot` zwL+delta :: Integer -> Fr -> [Fr] -> [Fr] -> Fr+delta n y zwL zwR= (powerVector (recip y) n `hadamard` zwR) `dot` zwL -commitBitVector :: (KnownNat p) => PrimeField p -> [PrimeField p] -> [PrimeField p] -> Crypto.Point-commitBitVector vBlinding vL vR = vLG `addP` vRH `addP` vBlindingH+commitBitVector :: Fr -> [Fr] -> [Fr] -> PA+commitBitVector vBlinding vL vR = vLG <> vRH <> vBlindingH   where-    vBlindingH = vBlinding `mulP` h+    vBlindingH = h `mul` vBlinding     vLG = sumExps vL gs     vRH = sumExps vR hs -shamirGxGxG :: (Show f, Num f) => Crypto.Point -> Crypto.Point -> Crypto.Point -> f+shamirGxGxG :: PA -> PA -> PA -> Fr shamirGxGxG p1 p2 p3-  = fromInteger $ oracle $ show _q <> pointToBS p1 <> pointToBS p2 <> pointToBS p3+  = oracle $ show _r <> pointToBS p1 <> pointToBS p2 <> pointToBS p3 -shamirGs :: (Show f, Num f) => [Crypto.Point] -> f-shamirGs ps = fromInteger $ oracle $ show _q <> foldMap pointToBS ps+shamirGs :: [PA] -> Fr+shamirGs ps = oracle $ show _r <> foldMap pointToBS ps -shamirZ :: (Show f, Num f) => f -> f-shamirZ z = fromInteger $ oracle $ show _q <> show z+shamirZ :: Fr -> Fr+shamirZ z = oracle $ show _r <> show z  --------------------------------------------- -- Polynomials@@ -144,7 +135,7 @@               Just x -> Map.insert (i + j) (x + (li `dot` rj)) accR               Nothing -> Map.insert (i + j) (li `dot` rj) accR           ) accL (zip [0..] r))-      (Map.empty :: Num n => Map.Map Int n)+      (Map.empty :: Map.Map Int n)       (zip [0..] l))  @@ -182,7 +173,7 @@ genZeroMatrix :: (Num f) => Integer -> Integer -> [[f]] genZeroMatrix (fromIntegral -> n) (fromIntegral -> m) = replicate n (replicate m 0) -computeInputValues :: (KnownNat p) => GateWeights (PrimeField p) -> [[PrimeField p]] -> Assignment (PrimeField p) -> [PrimeField p] -> [PrimeField p]+computeInputValues :: GateWeights (Fr) -> [[Fr]] -> Assignment (Fr) -> [Fr] -> [Fr] computeInputValues GateWeights{..} wV Assignment{..} cs   = solveLinearSystem $ zipWith (\row s -> reverse $ s : row) wV solutions   where@@ -191,7 +182,7 @@         ^+^ vectorMatrixProductT aO wO         ^-^ cs -gaussianReduce :: (KnownNat p) => [[PrimeField p]] -> [[PrimeField p]]+gaussianReduce :: [[Fr]] -> [[Fr]] gaussianReduce matrix = fixlastrow $ foldl reduceRow matrix [0..length matrix-1]   where     -- Swaps element at position a with element at position b.@@ -226,7 +217,7 @@         nz = List.last (List.init row)  -- Solve a matrix (must already be in REF form) by back substitution.-substituteMatrix :: (KnownNat p) => [[PrimeField p]] -> [PrimeField p]+substituteMatrix :: [[Fr]] -> [Fr] substituteMatrix matrix = foldr next [List.last (List.last matrix)] (List.init matrix)   where     next row found = let@@ -234,20 +225,20 @@       solution = List.last row - sum (zipWith (*) found subpart)       in solution : found -solveLinearSystem :: (KnownNat p) => [[PrimeField p]] -> [PrimeField p]+solveLinearSystem :: [[Fr]] -> [Fr] solveLinearSystem = reverse . substituteMatrix . gaussianReduce  ------------------------- -- Arbitrary instances -- ------------------------- -instance (KnownNat p) => Arbitrary (ArithCircuit (PrimeField p)) where+instance Arbitrary (ArithCircuit Fr) where   arbitrary = do     n <- choose (1, 100)     m <- choose (1, n)     arithCircuitGen n m -arithCircuitGen :: forall p. (KnownNat p) => Integer -> Integer -> Gen (ArithCircuit (PrimeField p))+arithCircuitGen :: Integer -> Integer -> Gen (ArithCircuit Fr) arithCircuitGen n m = do     -- TODO: Can lConstraints be a different value?     let lConstraints = m@@ -260,7 +251,7 @@     commitmentWeights <- wvGen lConstraints m     pure $ ArithCircuit gateWeights commitmentWeights cs       where-        gateWeightsGen :: Integer -> Integer -> Gen (GateWeights (PrimeField p))+        gateWeightsGen :: Integer -> Integer -> Gen (GateWeights (Fr))         gateWeightsGen lConstraints n = do           let genVec = ((\i -> insertAt i (oneVector n) (replicate (fromIntegral lConstraints - 1) (zeroVector n))) <$> choose (0, fromIntegral lConstraints))           wL <- genVec@@ -268,7 +259,7 @@           wO <- genVec           pure $ GateWeights wL wR wO -        wvGen :: Integer -> Integer -> Gen [[PrimeField p]]+        wvGen :: Integer -> Integer -> Gen [[Fr]]         wvGen lConstraints m           | lConstraints < m = panic "Number of constraints must be bigger than m"           | otherwise = shuffle (genIdenMatrix m ++ genZeroMatrix (lConstraints - m) m)@@ -276,19 +267,19 @@         oneVector x = replicate (fromIntegral x) 1  -instance (KnownNat p) => Arbitrary (Assignment (PrimeField p)) where+instance Arbitrary (Assignment Fr) where   arbitrary = do     n <- (arbitrary :: Gen Integer)     arithAssignmentGen n -arithAssignmentGen :: (KnownNat p) => Integer -> Gen (Assignment (PrimeField p))+arithAssignmentGen :: Integer -> Gen (Assignment Fr) arithAssignmentGen n = do     aL <- vectorOf (fromIntegral n) (fromInteger <$> choose (0, 2^n))     aR <- vectorOf (fromIntegral n) (fromInteger <$> choose (0, 2^n))-    let aO = aL `hadamardp` aR+    let aO = aL `hadamard` aR     pure $ Assignment aL aR aO -instance (KnownNat p) => Arbitrary (ArithWitness (PrimeField p)) where+instance Arbitrary (ArithWitness Fr PA) where   arbitrary = do     n <- choose (1, 100)     m <- choose (1, n)@@ -296,7 +287,7 @@     assignment <- arithAssignmentGen n     arithWitnessGen assignment arithCircuit m -arithWitnessGen :: (KnownNat p) => Assignment (PrimeField p) -> ArithCircuit (PrimeField p) -> Integer -> Gen (ArithWitness (PrimeField p))+arithWitnessGen :: Assignment Fr -> ArithCircuit Fr -> Integer -> Gen (ArithWitness Fr PA) arithWitnessGen assignment arith@ArithCircuit{..} m = do   commitBlinders <- vectorOf (fromIntegral m) arbitrary   let vs = computeInputValues weights commitmentWeights assignment cs

@@ -1,15 +1,12 @@-{-# LANGUAGE RecordWildCards, ScopedTypeVariables, ViewPatterns #-}+{-# LANGUAGE RecordWildCards, ScopedTypeVariables, ViewPatterns, TypeApplications #-} module Bulletproofs.ArithmeticCircuit.Prover where  import Protolude -import Crypto.Random.Types (MonadRandom(..))-import Crypto.Number.Generate (generateMax)-import qualified Crypto.PubKey.ECC.Prim as Crypto-import qualified Crypto.PubKey.ECC.Types as Crypto-import PrimeField (PrimeField(..), toInt)+import Control.Monad.Random (MonadRandom, getRandomR) -import Bulletproofs.Curve+import Data.Curve.Weierstrass.SECP256K1 (PA, Fr, _r, mul, gen, inv)+ import Bulletproofs.Utils hiding (shamirZ) import qualified Bulletproofs.InnerProductProof as IPP import Bulletproofs.ArithmeticCircuit.Internal@@ -17,15 +14,14 @@ -- | Generate a zero-knowledge proof of computation -- for an arithmetic circuit with a valid witness generateProof-  :: forall p m-   . (MonadRandom m, KnownNat p)-  => ArithCircuit (PrimeField p)-  -> ArithWitness (PrimeField p)-  -> m (ArithCircuitProof (PrimeField p))+  :: forall m . (MonadRandom m)+  => ArithCircuit Fr+  -> ArithWitness Fr PA+  -> m (ArithCircuitProof Fr PA) generateProof (padCircuit -> ArithCircuit{..}) ArithWitness{..} = do   let GateWeights{..} = weights       Assignment{..} = padAssignment assignment-      genBlinding = (fromInteger :: Integer -> PrimeField p) <$> generateMax _q+      genBlinding = (fromInteger :: Integer -> Fr) <$> getRandomR (1, fromIntegral _r - 1)   aiBlinding <- genBlinding   aoBlinding <- genBlinding   sBlinding <- genBlinding@@ -53,16 +49,16 @@         ^+^ (aR `vectorMatrixProductT` wR)         ^+^ (aO `vectorMatrixProductT` wO) -      t2 = (aL `dot` (aR `hadamardp` ys))+      _t2 = (aL `dot` (aR `hadamard` ys))          - (aO `dot` ys)          + (zs `dot` w)          + delta n y zwL zwR -  tBlindings <- insertAt 2 0 . (:) 0 <$> replicateM 5 ((fromInteger :: Integer -> PrimeField p) <$> generateMax _q)+  tBlindings <- insertAt 2 0 . (:) 0 <$> replicateM 5 ((fromInteger @Fr) <$> getRandomR (1, fromIntegral _r - 1))   let tCommits = zipWith commit tPoly tBlindings    let x = shamirGs tCommits-      evalTCommit = sumExps (powerVector x 7) tCommits+      _evalTCommit = sumExps (powerVector x 7) tCommits    let ls = evaluatePolynomial n lPoly x       rs = evaluatePolynomial n rPoly x@@ -76,17 +72,17 @@       mu = aiBlinding * x + aoBlinding * (x ^ 2) + sBlinding * (x ^ 3)    let uChallenge = shamirU tBlinding mu t-      u = uChallenge `mulP` g-      hs' = zipWith mulP (powerVector (recip y) n) hs-      gExp = (*) x <$> (powerVector (recip y) n `hadamardp` zwR)+      u = gen `mul` uChallenge+      hs' = zipWith mul hs (powerVector (recip y) n)+      gExp = (*) x <$> (powerVector (recip y) n `hadamard` zwR)       hExp = (((*) x <$> zwL) ^+^ zwO) ^-^ ys-      commitmentLR = (x `mulP` aiCommit)-                   `addP` ((x ^ 2) `mulP` aoCommit)-                   `addP` ((x ^ 3)`mulP` sCommit)-                   `addP` sumExps gExp gs-                   `addP` sumExps hExp hs'-                   `addP` Crypto.pointNegate curve (mu `mulP` h)-                   `addP` (t `mulP` u)+      commitmentLR = (aiCommit `mul` x)+                   <> (aoCommit `mul` (x ^ 2))+                   <> (sCommit `mul` (x ^ 3))+                   <> sumExps gExp gs+                   <> sumExps hExp hs'+                   <> (inv (h `mul` mu))+                   <> (u `mul` t)    let productProof = IPP.generateProof                         IPP.InnerProductBase { bGs = gs, bHs = hs', bH = u }@@ -111,12 +107,12 @@         )       where         l0 = replicate (fromIntegral n) 0-        l1 = aL ^+^ (powerVector (recip y) n `hadamardp` zwR)+        l1 = aL ^+^ (powerVector (recip y) n `hadamard` zwR)         l2 = aO         l3 = sL          r0 = zwO ^-^ powerVector y n-        r1 = (powerVector y n `hadamardp` aR) ^+^ zwL+        r1 = (powerVector y n `hadamard` aR) ^+^ zwL         r2 = replicate (fromIntegral n) 0-        r3 = powerVector y n `hadamardp` sR+        r3 = powerVector y n `hadamard` sR 

@@ -4,13 +4,9 @@ import Protolude hiding (head) import Data.List (head) -import qualified Crypto.PubKey.ECC.Prim as Crypto-import qualified Crypto.PubKey.ECC.Types as Crypto-import PrimeField (PrimeField(..), toInt)+import Data.Curve.Weierstrass.SECP256K1 (PA, Fr, mul, inv, gen) -import Bulletproofs.Curve import Bulletproofs.Utils hiding (shamirZ)-import Bulletproofs.RangeProof.Internal hiding (delta) import qualified Bulletproofs.InnerProductProof as IPP  import Bulletproofs.ArithmeticCircuit.Internal@@ -18,10 +14,9 @@ -- | Verify that a zero-knowledge proof holds -- for an arithmetic circuit given committed input values verifyProof-  :: (KnownNat p)-  => [Crypto.Point]-  -> ArithCircuitProof (PrimeField p)-  -> ArithCircuit (PrimeField p)+  :: [PA]+  -> ArithCircuitProof Fr PA+  -> ArithCircuit Fr   -> Bool verifyProof vCommits proof@ArithCircuitProof{..} (padCircuit -> ArithCircuit{..})   = verifyLRCommitment && verifyTPoly@@ -40,22 +35,17 @@     zwR = zs `vectorMatrixProduct` wR     zwO = zs `vectorMatrixProduct` wO -    hs' = zipWith mulP (powerVector (recip y) n) 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)+    hs' = zipWith mul hs (powerVector (recip y) n)      uChallenge = shamirU tBlinding mu t-    u = uChallenge `mulP` g+    u = gen `mul` uChallenge      verifyTPoly = lhs == rhs       where         lhs = commit t tBlinding-        rhs = (gExp `mulP` g)-            `addP` tCommitsExpSum-            `addP` sumExps vExp vCommits+        rhs = (gen `mul` gExp)+            <> tCommitsExpSum+            <> sumExps vExp vCommits         gExp = (x ^ 2) * (k + cQ)         cQ = zs `dot` cs         vExp = (*) (x ^ 2) <$> (zs `vectorMatrixProduct` commitmentWeights)@@ -70,12 +60,12 @@           commitmentLR           productProof       where-        gExp = (*) x <$> (powerVector (recip y) n `hadamardp` zwR)+        gExp = (*) x <$> (powerVector (recip y) n `hadamard` zwR)         hExp = (((*) x <$> zwL) ^+^ zwO) ^-^ ys-        commitmentLR = (x `mulP` aiCommit)-                     `addP` ((x ^ 2) `mulP` aoCommit)-                     `addP` ((x ^ 3) `mulP` sCommit)-                     `addP` sumExps gExp gs-                     `addP` sumExps hExp hs'-                     `addP` Crypto.pointNegate curve (mu `mulP` h)-                     `addP` (t `mulP` u)+        commitmentLR = (aiCommit `mul` x)+                     <> (aoCommit `mul` (x ^ 2))+                     <> (sCommit `mul` (x ^ 3))+                     <> sumExps gExp gs+                     <> sumExps hExp hs'+                     <> (inv (h `mul` mu))+                     <> (u `mul` t)

@@ -1,109 +0,0 @@-module Bulletproofs.Curve (-  _q,-  _a,-  _b,-  g,-  h,-  gs,-  hs,-  curve,-  oracle,-  pointToBS,-) where--import Protolude hiding (hash)-import Data.Maybe (fromJust)--import Crypto.Hash-import qualified Crypto.PubKey.ECC.Generate as Crypto-import qualified Crypto.PubKey.ECC.Prim as Crypto-import qualified Crypto.PubKey.ECC.Types as Crypto--import qualified Data.ByteArray as BA-import Crypto.Number.Serialize (os2ip)-import Math.NumberTheory.Moduli.Sqrt (sqrtsModPrime)-import Math.NumberTheory.UniqueFactorisation (isPrime)--import Numeric-import qualified Data.List as L---- Implementation using the elliptic curve secp256k12--- which has 128 bit security.--- Parameters as in Cryptonite:--- SEC_p256k1 = CurveFP  $ CurvePrime---     0xfffffffffffffffffffffffffffffffffffffffffffffffffffffffefffffc2f---     (CurveCommon---         { ecc_a = 0x0000000000000000000000000000000000000000000000000000000000000000---         , ecc_b = 0x0000000000000000000000000000000000000000000000000000000000000007---         , ecc_g = Point 0x79be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798---                         0x483ada7726a3c4655da4fbfc0e1108a8fd17b448a68554199c47d08ffb10d4b8---         , ecc_n = 0xfffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141---         , ecc_h = 1---         })-curveName :: Crypto.CurveName-curveName = Crypto.SEC_p256k1--curve :: Crypto.Curve-curve = Crypto.getCurveByName curveName---- | Order of the curve-_q :: Integer-_q = Crypto.ecc_n . Crypto.common_curve $ curve--_b :: Integer-_b = Crypto.ecc_b . Crypto.common_curve $ curve--_a :: Integer-_a = Crypto.ecc_a . Crypto.common_curve $ curve---- | Generator of the curve-g :: Crypto.Point-g = Crypto.ecc_g $ Crypto.common_curve curve---- | H = aG where a is not known-h :: Crypto.Point-h = generateH g ""---- | Generate vector of generators in a deterministic way from the curve generator g--- by applying H(encode(g) || i) where H is a secure hash function-gs :: [Crypto.Point]-gs = Crypto.pointBaseMul curve . oracle . (<> pointToBS g) . show <$> [1..]---- | Generate vector of generators in a deterministic way from the curve generator h--- by applying H(encode(h) || i) where H is a secure hash function-hs :: [Crypto.Point]-hs = Crypto.pointBaseMul curve . oracle . (<> pointToBS h) . show <$> [1..]---- | A random oracle. In the Fiat-Shamir heuristic, its input--- is specifically the transcript of the interaction up to that point.-oracle :: ByteString -> Integer-oracle x = os2ip (sha256 x)--sha256 :: ByteString -> ByteString-sha256 bs = BA.convert (hash bs :: Digest SHA3_256)--pointToBS :: Crypto.Point -> ByteString-pointToBS Crypto.PointO      = ""-pointToBS (Crypto.Point x y) = show x <> show y---- | Characteristic of the underlying finite field of the elliptic curve-_p :: Integer-_p = Crypto.ecc_p cp-  where-    cp = case curve of-      Crypto.CurveFP c -> c-      Crypto.CurveF2m _ -> panic "Not a FP curve"---- | Iterative algorithm to generate H.--- The important thing about the H value is that nobody gets--- to know its discrete logarithm "k" such that H = kG-generateH :: Crypto.Point -> [Char] -> Crypto.Point-generateH basePoint extra =-  case yM of-    [] -> generateH basePoint (toS $ '1':extra)-    (y:_) -> if Crypto.isPointValid curve (Crypto.Point x y)-      then Crypto.Point x y-      else generateH basePoint (toS $ '1':extra)-  where-    x = oracle (pointToBS basePoint <> toS extra) `mod` _p-    yM = sqrtsModPrime (fromInteger (x ^ 3 + 7)) ((fromJust (isPrime _p)))

@@ -1,18 +0,0 @@-{-# LANGUAGE TypeFamilies #-}--module Bulletproofs.Fq-  ( Fq-  , PF-  ) where--import Protolude--import PrimeField (PrimeField(..))-import Bulletproofs.Curve---- | Prime field @Fq@ with characteristic @_q@-type Fq = PrimeField 0xfffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141---- | Type family to extract the characteristic of the prime field-type family PF a where-  PF (PrimeField k) = k

@@ -7,14 +7,12 @@  import Protolude -import qualified Crypto.PubKey.ECC.Types as Crypto--data InnerProductProof f+data InnerProductProof f p   = InnerProductProof-    { lCommits :: [Crypto.Point]+    { lCommits :: [p]     -- ^ Vector of commitments of the elements in the original vector l     -- whose size is the logarithm of base 2 of the size of vector l-    , rCommits :: [Crypto.Point]+    , rCommits :: [p]     -- ^ Vector of commitments of the elements in the original vector r     -- whose size is the logarithm of base 2 of the size of vector r     , l :: f@@ -35,11 +33,11 @@     -- in the recursive inner product algorithm     } deriving (Show, Eq) -data InnerProductBase+data InnerProductBase p   = InnerProductBase-    { bGs :: [Crypto.Point]  -- ^ Independent generator Gs ∈ G^n-    , bHs :: [Crypto.Point]  -- ^ Independent generator Hs ∈ G^n-    , bH :: Crypto.Point+    { bGs :: [p]  -- ^ Independent generator Gs ∈ G^n+    , bHs :: [p]  -- ^ Independent generator Hs ∈ G^n+    , bH :: p     -- ^ Internally fixed group element H ∈  G     -- for which there is no known discrete-log relation among Gs, Hs, bG     } deriving (Show, Eq)

@@ -7,39 +7,31 @@ import Protolude  import Control.Exception (assert)-import qualified Data.List as L-import qualified Data.Map as Map--import qualified Crypto.PubKey.ECC.Types as Crypto-import PrimeField (PrimeField(..), toInt)+import Data.Curve.Weierstrass.SECP256K1 (PA, Fr, mul) -import Bulletproofs.Curve import Bulletproofs.Utils- import Bulletproofs.InnerProductProof.Internal  -- | Generate proof that a witness l, r satisfies the inner product relation -- on public input (Gs, Hs, h) generateProof-  :: KnownNat p-  => InnerProductBase    -- ^ Generators Gs, Hs, h-  -> Crypto.Point+  :: InnerProductBase PA   -- ^ Generators Gs, Hs, h+  -> PA   -- ^ Commitment P = A + xS − zG + (z*y^n + z^2 * 2^n) * hs' of vectors l and r   -- whose inner product is t-  -> InnerProductWitness (PrimeField p)+  -> InnerProductWitness Fr   -- ^ Vectors l and r that hide bit vectors aL and aR, respectively-  -> InnerProductProof (PrimeField p)+  -> InnerProductProof Fr PA generateProof productBase commitmentLR witness   = generateProof' productBase commitmentLR witness [] []  generateProof'-  :: KnownNat p-  => InnerProductBase-  -> Crypto.Point-  -> InnerProductWitness (PrimeField p)-  -> [Crypto.Point]-  -> [Crypto.Point]-  -> InnerProductProof (PrimeField p)+  :: InnerProductBase PA+  -> PA+  -> InnerProductWitness Fr+  -> [PA]+  -> [PA]+  -> InnerProductProof Fr PA generateProof'   InnerProductBase{ bGs, bHs, bH }   commitmentLR@@ -69,16 +61,16 @@     cR = dot lsRight rsLeft      lCommit = sumExps lsLeft gsRight-         `addP`+         <>          sumExps rsRight hsLeft-         `addP`-         (cL `mulP` bH)+         <>+         (bH `mul` cL)      rCommit = sumExps lsRight gsLeft-         `addP`+         <>          sumExps rsLeft hsRight-         `addP`-         (cR `mulP` bH)+         <>+         (bH `mul` cR)      x = shamirX' commitmentLR lCommit rCommit @@ -93,10 +85,10 @@     rs' = ((*) xInv <$> rsLeft) ^+^ ((*) x <$> rsRight)      commitmentLR'-      = ((x ^ 2) `mulP` lCommit)-        `addP`-        ((xInv ^ 2) `mulP` rCommit)-        `addP`+      = (lCommit `mul` (x ^ 2))+        <>+        (rCommit `mul` (xInv ^ 2))+        <>         commitmentLR      -----------------------------@@ -122,19 +114,19 @@       = lGs'         ==         sumExps ls bGs-        `addP`-        ((x ^ 2) `mulP` aL')-        `addP`-        ((xInv ^ 2) `mulP` aR')+        <>+        (aL' `mul` (x ^ 2))+        <>+        (aR' `mul` (xInv ^ 2))      checkRHs       = rHs'         ==         sumExps rs bHs-        `addP`-        ((x ^ 2) `mulP` bR')-        `addP`-        ((xInv ^ 2) `mulP` bL')+        <>+        (bR' `mul` (x ^ 2))+        <>+        (bL' `mul` (xInv ^ 2))      checkLBs       = dot ls' rs'@@ -144,17 +136,17 @@     checkC       = commitmentLR         ==-        (z `mulP` bH)-        `addP`+        (bH `mul` z)+        <>         lGs-        `addP`+        <>         rHs      checkC'       = commitmentLR'         ==-        (z' `mulP` bH)-        `addP`+        (bH `mul` z')+        <>         lGs'-        `addP`+        <>         rHs'

@@ -8,56 +8,51 @@  import qualified Data.List as L import qualified Data.Map as Map--import qualified Crypto.PubKey.ECC.Types as Crypto-import PrimeField (PrimeField(..), toInt)+import Data.Curve.Weierstrass.SECP256K1 (PA, Fr, mul) -import Bulletproofs.Curve import Bulletproofs.Utils  import Bulletproofs.InnerProductProof.Internal  -- | Optimized non-interactive verifier using multi-exponentiation and batch verification verifyProof-  :: KnownNat p-  => Integer            -- ^ Range upper bound-  -> InnerProductBase   -- ^ Generators Gs, Hs, h-  -> Crypto.Point       -- ^ Commitment P-  -> InnerProductProof (PrimeField p)+  :: Integer               -- ^ Range upper bound+  -> InnerProductBase PA   -- ^ Generators Gs, Hs, h+  -> PA                    -- ^ Commitment P+  -> InnerProductProof Fr PA   -- ^ Proof that a secret committed value lies in a certain interval   -> Bool verifyProof n productBase@InnerProductBase{..} commitmentLR productProof@InnerProductProof{ l, r }   = c == cProof   where-    (challenges, invChallenges, c) = mkChallenges productProof commitmentLR+    (challenges, _invChallenges, c) = mkChallenges productProof commitmentLR     otherExponents = mkOtherExponents n challenges     cProof-      = (l `mulP` gsCommit)-        `addP`-        (r `mulP` hsCommit)-        `addP`-        ((l * r) `mulP` bH)+      = (gsCommit `mul` l)+        <>+        (hsCommit `mul` r)+        <>+        (bH `mul` (l * r) )      gsCommit = sumExps otherExponents bGs     hsCommit = sumExps (reverse otherExponents) bHs  mkChallenges-  :: KnownNat p-  => InnerProductProof (PrimeField p)-  -> Crypto.Point-  -> ([PrimeField p], [PrimeField p], Crypto.Point)+  :: InnerProductProof Fr PA+  -> PA+  -> ([Fr], [Fr], PA) mkChallenges InnerProductProof{ lCommits, rCommits } commitmentLR   = foldl'       (\(xs, xsInv, accC) (li, ri)         -> let x = shamirX' accC li ri                xInv = recip x-               c = ((x ^ 2) `mulP` li) `addP` ((xInv ^ 2) `mulP` ri) `addP` accC+               c = (li `mul` (x ^ 2)) <> (ri `mul` (xInv ^ 2)) <> accC            in (x:xs, xInv:xsInv, c)       )       ([], [], commitmentLR)       (zip lCommits rCommits) -mkOtherExponents :: forall p . KnownNat p => Integer -> [PrimeField p] -> [PrimeField p]+mkOtherExponents :: Integer -> [Fr] -> [Fr] mkOtherExponents n challenges   = Map.elems $ foldl'       f@@ -67,7 +62,7 @@     n' = n `div` 2     f acc i = foldl' (f' i) acc [0..logBase2 n-1] -    f' :: Integer -> Map.Map Integer (PrimeField p) -> Integer -> Map.Map Integer (PrimeField p)+    f' :: Integer -> Map.Map Integer Fr -> Integer -> Map.Map Integer Fr     f' i acc' j       = let i1 = (2^j) + i in           if | i1 >= n -> acc'

@@ -7,43 +7,35 @@  import Protolude -import Crypto.Random.Types (MonadRandom(..))-import Crypto.Number.Generate (generateMax)-import qualified Crypto.PubKey.ECC.Generate as Crypto-import qualified Crypto.PubKey.ECC.Prim as Crypto-import qualified Crypto.PubKey.ECC.Types as Crypto-import PrimeField (PrimeField(..), toInt)+import Control.Monad.Random (MonadRandom, getRandomR)+import Data.Curve.Weierstrass.SECP256K1 (PA, Fr, _r, mul, gen) -import Bulletproofs.Curve import Bulletproofs.Utils import Bulletproofs.RangeProof.Internal- import Bulletproofs.InnerProductProof as IPP hiding (generateProof) import qualified Bulletproofs.InnerProductProof as IPP  -- | Prove that a list of values lies in a specific range generateProof-  :: (KnownNat p, MonadRandom m)+  :: MonadRandom m   => Integer                -- ^ Upper bound of the range we want to prove-  -> [(PrimeField p, PrimeField p)]+  -> [(Fr, Fr)]   -- ^ Values we want to prove in range and their blinding factors-  -> ExceptT (RangeProofError (PrimeField p)) m (RangeProof (PrimeField p))+  -> ExceptT (RangeProofError Fr) m (RangeProof Fr PA) generateProof upperBound vsAndvBlindings = do-  unless (upperBound < _q) $ throwE $ UpperBoundTooLarge upperBound+  unless (upperBound < fromIntegral _r) $ throwE $ UpperBoundTooLarge upperBound    case doubleLogM of      Nothing -> throwE $ NNotPowerOf2 upperBound      Just n -> do        unless (checkRanges n vs) $ throwE $ ValuesNotInRange vs-        lift $ generateProofUnsafe upperBound vsAndvBlindingsExp2    where     doubleLogM :: Maybe Integer     doubleLogM = do       x <- logBase2M upperBound-      logBase2M x-      pure x+      logBase2M x >> pure x     vs = fst <$> vsAndvBlindings     m = length vsAndvBlindings     residue = replicate (2 ^ log2Ceil m - m) (0, 0)@@ -53,12 +45,12 @@  -- | Generate range proof from valid inputs generateProofUnsafe-  :: forall p m-   . (KnownNat p, MonadRandom m)+  :: forall m+   . MonadRandom m   => Integer    -- ^ Upper bound of the range we want to prove-  -> [(PrimeField p, PrimeField p)]+  -> [(Fr, Fr)]   -- ^ Values we want to prove in range and their blinding factors-  -> m (RangeProof (PrimeField p))+  -> m (RangeProof Fr PA) generateProofUnsafe upperBound vsAndvBlindings = do   let n = logBase2 upperBound       m = fromIntegral $ length vsAndvBlindings@@ -72,7 +64,7 @@    (sL, sR) <- chooseBlindingVectors nm -  let genBlinding = (fromInteger :: Integer -> (PrimeField p)) <$> generateMax _q+  let genBlinding = fromInteger <$> getRandomR (1, fromIntegral _r - 1)    aBlinding <- genBlinding   sBlinding <- genBlinding@@ -84,7 +76,7 @@       z = shamirZ aCommit sCommit y    let lrPoly@LRPolys{..} = computeLRPolys n m aL aR sL sR y z-      tPoly@TPoly{..} = computeTPoly lrPoly+      TPoly{..} = computeTPoly lrPoly    t1Blinding <- genBlinding   t2Blinding <- genBlinding@@ -111,8 +103,8 @@       mu = aBlinding + (sBlinding * x)    let uChallenge = shamirU tBlinding mu t-      u = uChallenge `mulP` g-      hs' = zipWith (\yi hi-> recip yi `mulP` hi) (powerVector y nm) hs+      u = gen `mul` uChallenge+      hs' = zipWith (\yi hi-> hi `mul` recip yi) (powerVector y nm) hs       commitmentLR = computeLRCommitment n m aCommit sCommit t tBlinding mu x y z hs'       productProof = IPP.generateProof                         InnerProductBase { bGs = gs, bHs = hs', bH = u }@@ -139,23 +131,22 @@ -- l(x) = (a L − z1 n ) + s L x -- r(x) = y^n ◦ (aR + z * 1^n + sR * x) + z^2 * 2^n computeLRPolys-  :: (KnownNat p)-  => Integer+  :: Integer   -> Integer-  -> [PrimeField p]-  -> [PrimeField p]-  -> [PrimeField p]-  -> [PrimeField p]-  -> PrimeField p-  -> PrimeField p-  -> LRPolys (PrimeField p)+  -> [Fr]+  -> [Fr]+  -> [Fr]+  -> [Fr]+  -> Fr+  -> Fr+  -> LRPolys Fr computeLRPolys n m aL aR sL sR y z   = LRPolys         { l0 = aL ^-^ ((*) z <$> powerVector 1 nm)         , l1 = sL-        , r0 = (powerVector y nm `hadamardp` (aR ^+^ z1nm))+        , r0 = (powerVector y nm `hadamard` (aR ^+^ z1nm))              ^+^ foldl' (\acc j -> iter j ^+^ acc) (replicate (fromIntegral nm) 0) [1..m]-        , r1 = hadamardp (powerVector y nm) sR+        , r1 = hadamard (powerVector y nm) sR         }   where     z1nm = (*) z <$> powerVector 1 nm

@@ -7,26 +7,19 @@ ) where  import Protolude-import Prelude (zipWith3) -import qualified Crypto.PubKey.ECC.Generate as Crypto-import qualified Crypto.PubKey.ECC.Prim as Crypto-import qualified Crypto.PubKey.ECC.Types as Crypto-import PrimeField (PrimeField(..), toInt)+import Data.Curve.Weierstrass.SECP256K1 (PA, Fr, mul, gen)  import Bulletproofs.RangeProof.Internal-import Bulletproofs.Curve import Bulletproofs.Utils- import Bulletproofs.InnerProductProof as IPP hiding (verifyProof) import qualified Bulletproofs.InnerProductProof as IPP  -- | Verify that a commitment was computed from a value in a given range verifyProof-  :: KnownNat p-  => Integer        -- ^ Range upper bound-  -> [Crypto.Point]   -- ^ Commitments of in-range values-  -> RangeProof (PrimeField p)+  :: Integer     -- ^ Range upper bound+  -> [PA]        -- ^ Commitments of in-range values+  -> RangeProof Fr PA   -- ^ Proof that a secret committed value lies in a certain interval   -> Bool verifyProof upperBound vCommits proof@RangeProof{..}@@ -42,21 +35,20 @@     m = length vCommits     -- Vector of values passed must be of length 2^x     vCommitsExp2 = vCommits ++ residueCommits-    residueCommits = replicate (2 ^ log2Ceil m - m) Crypto.PointO+    residueCommits = replicate (2 ^ log2Ceil m - m) mempty     mExp2 = fromIntegral $ length vCommitsExp2  -- | Verify the constant term of the polynomial t -- t = t(x) = t0 + t1*x + t2*x^2 -- This is what binds the proof to the actual original Pedersen commitment V to the actual value verifyTPoly-  :: KnownNat p-  => Integer         -- ^ Dimension n of the vectors-  -> [Crypto.Point]   -- ^ Commitments of in-range values-  -> RangeProof (PrimeField p)+  :: Integer         -- ^ Dimension n of the vectors+  -> [PA]   -- ^ Commitments of in-range values+  -> RangeProof Fr PA   -- ^ Proof that a secret committed value lies in a certain interval-  -> PrimeField p              -- ^ Challenge x-  -> PrimeField p              -- ^ Challenge y-  -> PrimeField p              -- ^ Challenge z+  -> Fr              -- ^ Challenge x+  -> Fr              -- ^ Challenge y+  -> Fr              -- ^ Challenge z   -> Bool verifyTPoly n vCommits proof@RangeProof{..} x y z   = lhs == rhs@@ -65,23 +57,22 @@     lhs = commit t tBlinding     rhs =           sumExps ((*) (z ^ 2) <$> powerVector z m) vCommits-          `addP`-          (delta n m y z `mulP` g)-          `addP`-          (x `mulP` t1Commit)-          `addP`-          ((x ^ 2) `mulP` t2Commit)+          <>+          (gen `mul` delta n m y z)+          <>+          (t1Commit `mul` x)+          <>+          (t2Commit `mul` (x ^ 2))  -- | Verify the inner product argument for the vectors l and r that form t verifyLRCommitment-  :: KnownNat p-  => Integer         -- ^ Dimension n of the vectors+  :: Integer         -- ^ Dimension n of the vectors   -> Integer-  -> RangeProof (PrimeField p)+  -> RangeProof Fr PA   -- ^ Proof that a secret committed value lies in a certain interval-  -> PrimeField p              -- ^ Challenge x-  -> PrimeField p              -- ^ Challenge y-  -> PrimeField p              -- ^ Challenge z+  -> Fr              -- ^ Challenge x+  -> Fr              -- ^ Challenge y+  -> Fr              -- ^ Challenge z   -> Bool verifyLRCommitment n m proof@RangeProof{..} x y z   = IPP.verifyProof@@ -91,7 +82,7 @@       productProof   where     commitmentLR = computeLRCommitment n m aCommit sCommit t tBlinding mu x y z hs'-    hs' = zipWith (\yi hi-> recip yi `mulP` hi) (powerVector y nm) hs+    hs' = zipWith (\yi hi-> hi `mul` recip yi) (powerVector y nm) hs     uChallenge = shamirU tBlinding mu t-    u = uChallenge `mulP` g+    u = gen `mul` uChallenge     nm = n * m

@@ -6,17 +6,13 @@ import Numeric (showIntAtBase) import Data.Char (intToDigit, digitToInt) -import Crypto.Number.Generate (generateMax)-import Crypto.Random.Types (MonadRandom(..))-import qualified Crypto.PubKey.ECC.Prim as Crypto-import qualified Crypto.PubKey.ECC.Types as Crypto-import PrimeField (PrimeField(..), toInt)-+import Control.Monad.Random (MonadRandom)+import Data.Field.Galois (PrimeField(..))+import Data.Curve.Weierstrass.SECP256K1 (PA, Fr, mul, inv, gen) import Bulletproofs.Utils-import Bulletproofs.Curve import Bulletproofs.InnerProductProof.Internal -data RangeProof f+data RangeProof f p   = RangeProof     { tBlinding :: f     -- ^ Blinding factor of the T1 and T2 commitments,@@ -26,17 +22,17 @@     , t :: f     -- ^ Dot product of vectors l and r that prove knowledge of the value in range     -- t = t(x) = l(x) · r(x)-    , aCommit :: Crypto.Point+    , aCommit :: p     -- ^ Commitment to aL and aR, where aL and aR are vectors of bits     -- such that aL · 2^n = v and aR = aL − 1^n .     -- A = α · H + aL · G + aR · H-    , sCommit :: Crypto.Point+    , sCommit :: p     -- ^ Commitment to new vectors sL, sR, created at random by the Prover-    , t1Commit :: Crypto.Point+    , t1Commit :: p     -- ^ Pedersen commitment to coefficient t1-    , t2Commit :: Crypto.Point+    , t2Commit :: p     -- ^ Pedersen commitment to coefficient t2-    , productProof :: InnerProductProof f+    , productProof :: InnerProductProof f p     -- ^ 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, Generic, NFData)@@ -74,16 +70,15 @@ -- | Encode the value v into a bit representation. Let aL be a vector -- of bits such that <aL, 2^n> = v (put more simply, the components of a L are the -- binary digits of v).-encodeBit :: KnownNat p => Integer -> PrimeField p -> [PrimeField p]-encodeBit n v = fillWithZeros n $ fromIntegral . digitToInt <$> showIntAtBase 2 intToDigit (toInt v) ""+encodeBit :: Integer -> Fr -> [Fr]+encodeBit n v = fillWithZeros n $ fromIntegral . digitToInt <$> showIntAtBase 2 intToDigit (fromP v) ""  -- | Bits of v reversed. -- v = <a, 2^n> = a_0 * 2^0 + ... + a_n-1 * 2^(n-1)-reversedEncodeBit :: KnownNat p => Integer -> PrimeField p -> [PrimeField p]+reversedEncodeBit :: Integer -> Fr -> [Fr] reversedEncodeBit n = reverse . encodeBit n --- TODO: Test it-reversedEncodeBitMulti :: KnownNat p => Integer -> [PrimeField p] -> [PrimeField p]+reversedEncodeBitMulti :: Integer -> [Fr] -> [Fr] reversedEncodeBitMulti n = foldl' (\acc v -> acc ++ reversedEncodeBit n v) []  -- | In order to prove that v is in range, each element of aL is either 0 or 1.@@ -103,11 +98,11 @@ -- | Obfuscate encoded bits with challenges y and z. -- z^2 * <aL, 2^n> + z * <aL − 1^n − aR, y^n> + <aL, aR · y^n> = (z^2) * v -- The property holds because <aL − 1^n − aR, y^n> = 0 and <aL · aR,  y^n> = 0-obfuscateEncodedBits :: KnownNat p => Integer -> [PrimeField p] -> [PrimeField p] -> PrimeField p -> PrimeField p -> PrimeField p+obfuscateEncodedBits :: Integer -> [Fr] -> [Fr] -> Fr -> Fr -> Fr obfuscateEncodedBits n aL aR y z   = ((z ^ 2) * dot aL (powerVector 2 n))     + (z * dot ((aL ^-^ powerVector 1 n) ^-^ aR) yN)-    + dot (hadamardp aL aR) yN+    + dot (hadamard aL aR) yN   where     yN = powerVector y n @@ -116,11 +111,11 @@ -- what’s important is that the aL , aR terms be kept inside -- (since they can’t be shared with the Verifier): -- <aL − z * 1^n , y^n ◦ (aR + z * 1^n) + z^2 * 2^n> = z 2 v + δ(y, z)-obfuscateEncodedBitsSingle :: KnownNat p => Integer -> [PrimeField p] -> [PrimeField p] -> PrimeField p -> PrimeField p -> PrimeField p+obfuscateEncodedBitsSingle :: Integer -> [Fr] -> [Fr] -> Fr -> Fr -> Fr obfuscateEncodedBitsSingle n aL aR y z   = dot       (aL ^-^ z1n)-      (hadamardp (powerVector y n) (aR ^+^ z1n) ^+^ ((*) (z ^ 2) <$> powerVector 2 n))+      (hadamard (powerVector y n) (aR ^+^ z1n) ^+^ ((*) (z ^ 2) <$> powerVector 2 n))   where     z1n = (*) z <$> powerVector 1 n @@ -130,31 +125,31 @@ -- these are properly blinded vector Pedersen commitments: commitBitVectors   :: (MonadRandom m)-  => PrimeField p-  -> PrimeField p-  -> [PrimeField p]-  -> [PrimeField p]-  -> [PrimeField p]-  -> [PrimeField p]-  -> m (Crypto.Point, Crypto.Point)+  => Fr+  -> Fr+  -> [Fr]+  -> [Fr]+  -> [Fr]+  -> [Fr]+  -> m (PA, PA) commitBitVectors aBlinding sBlinding aL aR sL sR = do     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+        aBlindingH = mul h aBlinding+        sBlindingH = mul h sBlinding      -- Commitment to aL and aR-    let aCommit = aBlindingH `addP` aLG `addP` aRH+    let aCommit = aBlindingH <> aLG <> aRH      -- Commitment to sL and sR-    let sCommit = sBlindingH `addP` sLG `addP` sRH+    let sCommit = sBlindingH <> sLG <> sRH      pure (aCommit, sCommit)  -- | (z − z^2) * <1^n, y^n> − z^3 * <1^n, 2^n>-delta :: KnownNat p => Integer -> Integer -> PrimeField p -> PrimeField p -> PrimeField p+delta :: Integer -> Integer -> Fr -> Fr -> Fr delta n m y z   = ((z - (z ^ 2)) * dot (powerVector 1 nm) (powerVector y nm))   - foldl' (\acc j -> acc + ((z ^ (j + 2)) * dot (powerVector 1 n) (powerVector 2 n))) 0 [1..m]@@ -162,51 +157,50 @@     nm = n * m  -- | Check that a value is in a specific range-checkRange :: Integer -> PrimeField p -> Bool-checkRange n (toInt -> v) = v >= 0 && v < 2 ^ n+checkRange :: Integer -> Fr -> Bool+checkRange n (fromP -> v) = v >= 0 && v < 2 ^ n  -- | Check that a value is in a specific range-checkRanges :: Integer -> [PrimeField p] -> Bool-checkRanges n vs = and $ fmap (\(toInt -> v) -> v >= 0 && v < 2 ^ n) vs+checkRanges :: Integer -> [Fr] -> Bool+checkRanges n vs = and $ fmap (\(fromP -> v) -> v >= 0 && v < 2 ^ n) vs  -- | Compute commitment of linear vector polynomials l and r -- P = A + xS − zG + (z*y^n + z^2 * 2^n) * hs' computeLRCommitment-  :: KnownNat p-  => Integer+  :: Integer   -> Integer-  -> Crypto.Point-  -> Crypto.Point-  -> PrimeField p-  -> PrimeField p-  -> PrimeField p-  -> PrimeField p-  -> PrimeField p-  -> PrimeField p-  -> [Crypto.Point]-  -> Crypto.Point+  -> PA+  -> PA+  -> Fr+  -> Fr+  -> Fr+  -> Fr+  -> Fr+  -> Fr+  -> [PA]+  -> PA computeLRCommitment n m aCommit sCommit t tBlinding mu x y z hs'   = aCommit                                               -- A-    `addP`-    (x `mulP` sCommit)                                    -- xS-    `addP`-    Crypto.pointNegate curve (z `mulP` gsSum)             -- (- zG)-    `addP`+    <>+    (sCommit `mul` x)                                    -- xS+    <>+    (inv (gsSum `mul` z))             -- (- zG)+    <>     sumExps hExp hs'     -- (hExp Hs')-    `addP`+    <>     foldl'-      (\acc j -> acc `addP` sumExps (hExp' j) (sliceHs' j))-      Crypto.PointO+      (\acc j -> acc <> sumExps (hExp' j) (sliceHs' j))+      mempty       [1..m]-    `addP`-    Crypto.pointNegate curve (mu `mulP` h)-    `addP`-    (t `mulP` u)+    <>+    (inv (h `mul` mu))+    <>+    (u `mul` t)     where-      gsSum = foldl' addP Crypto.PointO (take (fromIntegral nm) gs)+      gsSum = foldl' (<>) mempty (take (fromIntegral nm) gs)       hExp = (*) z <$> powerVector y nm       hExp' j = (*) (z ^ (j+1)) <$> powerVector 2 n       sliceHs' j = slice n j hs'       uChallenge = shamirU tBlinding mu t-      u = uChallenge `mulP` g+      u = gen `mul` uChallenge       nm = n * m

@@ -5,29 +5,29 @@  import Protolude -import Crypto.Random.Types (MonadRandom(..))-import PrimeField (PrimeField(..), toInt)+import Control.Monad.Random (MonadRandom)+import Data.Curve.Weierstrass.SECP256K1 (PA, Fr)  import Bulletproofs.RangeProof.Internal import qualified Bulletproofs.MultiRangeProof.Prover as MRP  -- | Prove that a value lies in a specific range generateProof-  :: (KnownNat p, MonadRandom m)+  :: (MonadRandom m)   => Integer                -- ^ Upper bound of the range we want to prove-  -> (PrimeField p, PrimeField p)+  -> (Fr, Fr)   -- ^ Values we want to prove in range and their blinding factors-  -> ExceptT (RangeProofError (PrimeField p)) m (RangeProof (PrimeField p))+  -> ExceptT (RangeProofError Fr) m (RangeProof Fr PA) generateProof upperBound (v, vBlinding) =   MRP.generateProof upperBound [(v, vBlinding)]  -- | Generate range proof from valid inputs generateProofUnsafe-  :: (KnownNat p, MonadRandom m)+  :: (MonadRandom m)   => Integer    -- ^ Upper bound of the range we want to prove-  -> (PrimeField p, PrimeField p)+  -> (Fr, Fr)   -- ^ Values we want to prove in range and their blinding factors-  -> m (RangeProof (PrimeField p))+  -> m (RangeProof Fr PA) generateProofUnsafe upperBound (v, vBlinding) =   MRP.generateProofUnsafe upperBound [(v, vBlinding)] 

@@ -8,21 +8,16 @@  import Protolude -import qualified Crypto.PubKey.ECC.Types as Crypto-import PrimeField (PrimeField(..), toInt)+import Data.Curve.Weierstrass.SECP256K1 (PA, Fr)  import Bulletproofs.RangeProof.Internal-import Bulletproofs.Curve-import Bulletproofs.Utils- import qualified Bulletproofs.MultiRangeProof.Verifier as MRP  -- | Verify that a commitment was computed from a value in a given range verifyProof-  :: KnownNat p-  => Integer        -- ^ Range upper bound-  -> Crypto.Point   -- ^ Commitments of in-range values-  -> RangeProof (PrimeField p)+  :: Integer        -- ^ Range upper bound+  -> PA   -- ^ Commitments of in-range values+  -> RangeProof Fr PA   -- ^ Proof that a secret committed value lies in a certain interval   -> Bool verifyProof upperBound vCommit proof@RangeProof{..}@@ -32,27 +27,25 @@ -- t = t(x) = t0 + t1*x + t2*x^2 -- This is what binds the proof to the actual original Pedersen commitment V to the actual value verifyTPoly-  :: KnownNat p-  => Integer         -- ^ Dimension n of the vectors-  -> Crypto.Point    -- ^ Commitment of in-range value-  -> RangeProof (PrimeField p)+  :: Integer         -- ^ Dimension n of the vectors+  -> PA    -- ^ Commitment of in-range value+  -> RangeProof Fr PA   -- ^ Proof that a secret committed value lies in a certain interval-  -> PrimeField p              -- ^ Challenge x-  -> PrimeField p              -- ^ Challenge y-  -> PrimeField p              -- ^ Challenge z+  -> Fr              -- ^ Challenge x+  -> Fr              -- ^ Challenge y+  -> Fr              -- ^ Challenge z   -> Bool verifyTPoly n vCommit   = MRP.verifyTPoly n [vCommit]  -- | Verify the inner product argument for the vectors l and r that form t verifyLRCommitment-  :: KnownNat p-  => Integer         -- ^ Dimension n of the vectors-  -> RangeProof (PrimeField p)+  :: Integer         -- ^ Dimension n of the vectors+  -> RangeProof Fr PA   -- ^ Proof that a secret committed value lies in a certain interval-  -> PrimeField p              -- ^ Challenge x-  -> PrimeField p              -- ^ Challenge y-  -> PrimeField p              -- ^ Challenge z+  -> Fr              -- ^ Challenge x+  -> Fr              -- ^ Challenge y+  -> Fr              -- ^ Challenge z   -> Bool verifyLRCommitment n   = MRP.verifyLRCommitment n 1

@@ -1,62 +1,88 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DataKinds #-} module Bulletproofs.Utils where -import Protolude+import Protolude hiding (hash, fromStrict) -import qualified Crypto.PubKey.ECC.Prim as Crypto-import qualified Crypto.PubKey.ECC.Types as Crypto-import Crypto.Random (MonadRandom)-import Crypto.Number.Generate (generateMax)-import PrimeField (PrimeField, toInt)+import Control.Monad.Random (getRandomR, MonadRandom)+import Data.Field.Galois (PrimeField(..), sr)+import Data.Curve.Weierstrass.SECP256K1 (PA, Fr, Point(..), _r, def, mul, gen)+import Data.Digest.Pure.SHA (integerDigest, sha256)+import Data.ByteString.Lazy (fromStrict) -import Bulletproofs.Fq as Fq hiding (asInteger)-import Bulletproofs.Curve+-- | H = aG where a is not known+h :: PA+h = generateH "" +-- | Generate vector of generators in a deterministic way from the curve generator g+-- by applying H(encode(g) || i) where H is a secure hash function+gs :: [PA]+gs = mul gen . oracle . (<> pointToBS gen) . show <$> [1..]++-- | Generate vector of generators in a deterministic way from the curve generator h+-- by applying H(encode(h) || i) where H is a secure hash function+hs :: [PA]+hs = mul gen . oracle . (<> pointToBS h) . show <$> [1..]++-- | A random oracle. In the Fiat-Shamir heuristic, its input+-- is specifically the transcript of the interaction up to that point.+oracle :: PrimeField f => ByteString -> f+oracle = fromInteger . integerDigest . sha256 . fromStrict++pointToBS :: PA -> ByteString+pointToBS = show++-- | Iterative algorithm to generate H.+-- The important thing about the H value is that nobody gets+-- to know its discrete logarithm "k" such that H = kG+generateH :: [Char] -> PA+generateH extra =+  case yM of+    Nothing -> generateH (toS $ '1':extra)+    Just y -> if def (A x y :: PA)+      then A x y+      else generateH (toS $ '1':extra)+  where+    x = oracle (pointToBS gen <> toS extra)+    yM = sr (x ^ 3 + 7)+ -- | Return a vector containing the first n powers of a powerVector :: (Eq f, Num f) => f -> Integer -> [f] powerVector a x   = (\i -> if i == 0 && a == 0 then 0 else a ^ i) <$> [0..x-1]  -- | Hadamard product or entry wise multiplication of two vectors-hadamardp :: Num a => [a] -> [a] -> [a]-hadamardp a b | length a == length b = zipWith (*) a b-              | otherwise = panic "Vector sizes must match"+hadamard :: Num a => [a] -> [a] -> [a]+hadamard a b | length a == length b = zipWith (*) a b+             | otherwise = panic "Vector sizes must match" +-- | Dot product dot :: Num a => [a] -> [a] -> a-dot xs ys = sum $ hadamardp xs ys+dot xs ys = sum $ hadamard xs ys +-- | Entry wise sum (^+^) :: Num a => [a] -> [a] -> [a] (^+^) = zipWith (+) +-- | Entry wise subtraction (^-^) :: Num a => [a] -> [a] -> [a] (^-^) = zipWith (-) --- | Add two points of the same curve-addP :: Crypto.Point -> Crypto.Point -> Crypto.Point-addP = Crypto.pointAdd curve---- | Substract two points of the same curve-subP :: Crypto.Point -> Crypto.Point -> Crypto.Point-subP x y = Crypto.pointAdd curve x (Crypto.pointNegate curve y)---- | Multiply a scalar and a point in an elliptic curve-mulP :: PrimeField p -> Crypto.Point -> Crypto.Point-mulP x = Crypto.pointMul curve (toInt x)- -- | Double exponentiation (Shamir's trick): g0^x0 + g1^x1-addTwoMulP :: PrimeField p -> Crypto.Point -> PrimeField p -> Crypto.Point -> Crypto.Point-addTwoMulP exp0 pt0 exp1 pt1 = Crypto.pointAddTwoMuls curve (toInt exp0) pt0 (toInt exp1) pt1+addTwoMulP :: Fr -> PA -> Fr -> PA -> PA+addTwoMulP exp0 pt0 exp1 pt1 = (pt0 `mul` exp0) <> (pt1 `mul` exp1)  -- | Raise every point to the corresponding exponent, sum up results-sumExps :: [PrimeField p] -> [Crypto.Point] -> Crypto.Point+sumExps :: [Fr] -> [PA] -> PA 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+  = addTwoMulP exp0 pt0 exp1 pt1 <> sumExps exps pts+sumExps (exp:_) (pt:_) = pt `mul` exp -- this also catches cases where either list is longer than the other+sumExps _ _ = mempty  -- this catches cases where either list is empty  -- | Create a Pedersen commitment to a value given -- a value and a blinding factor-commit :: PrimeField p -> PrimeField p -> Crypto.Point-commit x r = addTwoMulP x g r h+commit :: Fr -> Fr -> PA+commit x r = addTwoMulP x gen r h  isLogBase2 :: Integer -> Bool isLogBase2 x@@ -104,52 +130,45 @@                  else 0  randomN :: MonadRandom m => Integer -> m Integer-randomN n = generateMax (2^n)+randomN n = getRandomR (1, 2^n - 1)  chooseBlindingVectors :: (Num f, MonadRandom m) => Integer -> m ([f], [f]) chooseBlindingVectors n = do-  sL <- replicateM (fromInteger n) (fromInteger <$> generateMax (2^n))-  sR <- replicateM (fromInteger n) (fromInteger <$> generateMax (2^n))+  sL <- replicateM (fromInteger n) (fromInteger <$> getRandomR (1, 2^n - 1))+  sR <- replicateM (fromInteger n) (fromInteger <$> getRandomR (1, 2^n - 1))   pure (sL, sR)  -------------------------------------------------- -- Fiat-Shamir transformations -------------------------------------------------- -shamirY :: Num f => Crypto.Point -> Crypto.Point -> f+shamirY :: PA -> PA -> Fr shamirY aCommit sCommit-  = fromInteger $ oracle $-      show _q <> pointToBS aCommit <> pointToBS sCommit+  = oracle $+      show _r <> pointToBS aCommit <> pointToBS sCommit -shamirZ :: (Show f, Num f) => Crypto.Point -> Crypto.Point -> f -> f+shamirZ :: PA -> PA -> Fr -> Fr shamirZ aCommit sCommit y-  = fromInteger $ oracle $-      show _q <> pointToBS aCommit <> pointToBS sCommit <> show y+  = oracle $+      show _r <> pointToBS aCommit <> pointToBS sCommit <> show y  shamirX-  :: (Show f, Num f)-  => Crypto.Point-  -> Crypto.Point-  -> Crypto.Point-  -> Crypto.Point-  -> f-  -> f-  -> f+  :: PA+  -> PA+  -> PA+  -> PA+  -> Fr+  -> Fr+  -> Fr shamirX aCommit sCommit t1Commit t2Commit y z-  = fromInteger $ oracle $-      show _q <> pointToBS aCommit <> pointToBS sCommit <> pointToBS t1Commit <> pointToBS t2Commit <> show y <> show z+  = oracle $+      show _r <> pointToBS aCommit <> pointToBS sCommit <> pointToBS t1Commit <> pointToBS t2Commit <> show y <> show z -shamirX'-  :: Num f-  => Crypto.Point-  -> Crypto.Point-  -> Crypto.Point-  -> f+shamirX' :: PA -> PA -> PA -> Fr shamirX' commitmentLR l' r'-  = fromInteger $ oracle $-      show _q <> pointToBS l' <> pointToBS r' <> pointToBS commitmentLR+  = oracle $+      show _r <> pointToBS l' <> pointToBS r' <> pointToBS commitmentLR -shamirU :: (Show f, Num f) => f -> f -> f -> f+shamirU :: Fr -> Fr -> Fr -> Fr shamirU tBlinding mu t-  = fromInteger $ oracle $-      show _q <> show tBlinding <> show mu <> show t+  = oracle $ show _r <> show tBlinding <> show mu <> show t

@@ -1,5 +1,10 @@ # Changelog for bulletproofs +## 1.1++* Use elliptic-curve library as dependency+* Update to galois-field-1.0+ ## 1.0.1  * Fix arithmoi dependency.

@@ -98,14 +98,13 @@ -------------------  ```haskell+import Data.Curve.Weierstrass.SECP256K1 (Fr) import qualified Bulletproofs.RangeProof as RP+import Bulletproofs.Utils (commit) -testSingleRangeProof :: (Fq, Fq) -> IO Bool-testSingleRangeProof (v, vBlinding) = do+testSingleRangeProof :: Integer -> (Fr, Fr) -> IO Bool+testSingleRangeProof upperBound (v, vBlinding) = do   let vCommit = commit v vBlinding-      -- n needs to be a power of 2-      n = 2 ^ 8-      upperBound = 2 ^ n    -- Prover   proofE <- runExceptT $ RP.generateProof upperBound (v, vBlinding)@@ -113,7 +112,7 @@   -- Verifier   case proofE of     Left err -> panic $ show err-    Right (proof@RP.RangeProof{..})+    Right proof@RP.RangeProof{..}       -> pure $ RP.verifyProof upperBound vCommit proof ``` @@ -121,14 +120,13 @@ ------------------  ```haskell+import Data.Curve.Weierstrass.SECP256K1 (Fr) import qualified Bulletproofs.MultiRangeProof as MRP+import Bulletproofs.Utils (commit) -testMultiRangeProof :: [(Fq, Fq)] -> IO Bool-testMultiRangeProof vsAndvBlindings = do+testMultiRangeProof :: Integer -> [(Fr, Fr)] -> IO Bool+testMultiRangeProof upperBound vsAndvBlindings = do   let vCommits = fmap (uncurry commit) vsAndvBlindings-      -- n needs to be a power of 2-      n = 2 ^ 8-      upperBound = 2 ^ n    -- Prover   proofE <- runExceptT $ MRP.generateProof upperBound vsAndvBlindings@@ -136,15 +134,15 @@   -- Verifier   case proofE of     Left err -> panic $ show err-    Right (proof@RP.RangeProof{..})+    Right proof@RP.RangeProof{..}       -> pure $ MRP.verifyProof upperBound vCommits proof ```  -The dimension _n_ needs to be a power of 2.-This implementation offers support for SECp256k1, a Koblitz curve.-Further information about this curve can be found in the Uplink docs:-[SECp256k1 curve](https://www.adjoint.io/docs/cryptography.html#id1 "SECp256k1 curve")+Note that the upper bound _u_ must be such that `u = 2 ^ n`, where _n_ is also a power of 2.+This implementation uses the elliptic curve secp256k1, a Koblitz curve, which+has 128 bit security.+See [Range proofs examples](./example/Example/RangeProof.hs) for further details.   Zero-knowledge proof for Arithmetic Circuits@@ -162,7 +160,10 @@ The input values _v_ used to generate the proof are then committed and shared with the Verifier.  ```haskell-import qualified Bulletproofs.ArithmeticCircuit+import Data.Curve.Weierstrass.SECP256K1 (Fr)+import Data.Field.Galois (rnd)+import Bulletproofs.ArithmeticCircuit+import Bulletproofs.Utils (hadamard, commit)  --  Example: --  2 linear constraints (q = 2):@@ -177,7 +178,7 @@ -- --  2 input values (m = 2) -arithCircuitExample :: ArithCircuit Fq+arithCircuitExample :: ArithCircuit Fr arithCircuitExample = ArithCircuit   { weights = GateWeights     { wL = [[1, 1, 1, 1]@@ -192,20 +193,18 @@   , cs = [0, 0]   } -testArithCircuitProof :: ([Fq], [Fq]) -> ArithCircuit Fq -> IO Bool+testArithCircuitProof :: ([Fr], [Fr]) -> ArithCircuit Fr -> IO Bool testArithCircuitProof (aL, aR) arithCircuit = do-  let n = 4-      m = 2-      q = 2+  let m = 2    -- Multiplication constraints-  let aO = aL `hadamardp` aR+  let aO = aL `hadamard` aR    -- Linear constraints       v0 = sum aL       v1 = sum aR -  commitBlinders <- replicateM m fqRandom+  commitBlinders <- replicateM m rnd   let commitments = zipWith commit [v0, v1] commitBlinders    let arithWitness = ArithWitness@@ -218,6 +217,7 @@    pure $ verifyProof commitments proof arithCircuit ```+See [Aritmetic circuit example](./example/Example/ArithmeticCircuit.hs) for further details.  **References**: 

@@ -0,0 +1,107 @@+module Bench.ArithCircuit where++import Protolude++import Criterion.Main+import Data.Curve.Weierstrass.SECP256K1 (PA, Fr)+import Bulletproofs.ArithmeticCircuit+import Bulletproofs.Utils (hadamard, commit)+-------------+-- Examples+-------------++-- Example 1+--+-- bL0     bR0    bL1      10+--  |       |      |       |+--  |--[+]--|      |--[+]--|+--      |              |+--      | bO0      bO1 |+--      |  =        =  |+--      |  aL      aR  |+--      |-----[x]------|+--             |+--             | aO+--             |+arithCircuitExample1 :: Fr -> Fr -> (ArithCircuit Fr, Assignment Fr, ArithWitness Fr PA)+arithCircuitExample1 x z =+  let wL = [[1], [0]]+      wR = [[0], [1]]+      wO = [[0], [0]]+      cs = [7 + 3, 2 + 10]+      aL = [10]+      aR = [12]+      aO = zipWith (*) aL aR+      gateWeights = GateWeights wL wR wO+      circuit = ArithCircuit gateWeights [] cs+      assignment = Assignment aL aR aO+      witness = ArithWitness assignment [] []+  in (circuit, assignment, witness)++-- Example 2+--+-- 5 linear constraint (q = 5):+-- aO[0] = aO[1]+-- aL[0] = V[0] - z+-- aL[1] = V[2] - z+-- aR[0] = V[1] - z+-- aR[1] = V[3] - z+--+-- 2 multiplication constraint (implicit) (n = 2):+-- aL[0] * aR[0] = aO[0]+-- aL[1] * aR[1] = aO[1]+--+-- 4 input values (m = 4)+arithCircuitExample2 :: Fr -> Fr -> (ArithCircuit Fr, Assignment Fr, ArithWitness Fr PA)+arithCircuitExample2 x z =+  let wL = [[0, 0]+           ,[1, 0]+           ,[0, 1]+           ,[0, 0]+           ,[0, 0]]+      wR = [[0, 0]+           ,[0, 0]+           ,[0, 0]+           ,[1, 0]+           ,[0, 1]]+      wO = [[1, -1]+           ,[0, 0]+           ,[0, 0]+           ,[0, 0]+           ,[0, 0]]+      wV = [[0, 0, 0, 0]+           ,[1, 0, 0, 0]+           ,[0, 0, 1, 0]+           ,[0, 1, 0 ,0]+           ,[0, 0, 0, 1]]+      cs = [0, -z, -z, -z, -z]+      aL = [4 - z, 9 - z]+      aR = [9 - z, 4 - z]+      aO = aL `hadamard` aR+      vs = [4, 9, 9, 4]+      blinders = [1, 2, 3, 4]+      commitments = zipWith commit vs blinders+      gateWeights = GateWeights wL wR wO+      circuit = ArithCircuit gateWeights wV cs+      assignment = Assignment aL aR aO+      witness = ArithWitness assignment commitments blinders+  in (circuit, assignment, witness)++exampleX :: Fr+exampleX = 11++exampleZ :: Fr+exampleZ = 12++runProtocolBench :: (ArithCircuit Fr, Assignment Fr, ArithWitness Fr PA) -> Benchmark+runProtocolBench (arithCircuit, assignment, arithWitness) = bgroup "Bulletproofs"+  [ bench "Prover" $ nfIO (generateProof arithCircuit arithWitness)+  , env (generateProof arithCircuit arithWitness) $ \proof ->+      bench "Verifier" $ nf (verifyProof (commitments arithWitness) proof) arithCircuit+  ]++benchmark :: [Benchmark]+benchmark =+  [ runProtocolBench $ arithCircuitExample2 exampleX exampleZ+  , runProtocolBench $ arithCircuitExample1 exampleX exampleZ+  ]

@@ -0,0 +1,37 @@+module Bench.RangeProof where++import Protolude+import Criterion.Main+import Data.Curve.Weierstrass.SECP256K1 (PA, Fr)++import qualified Bulletproofs.RangeProof as RP+import qualified Bulletproofs.Utils as Utils++upperBound :: Integer+upperBound = 2 ^ (2 ^ 6)++rangeInput :: (Fr, Fr)+rangeInput = (7238283, 827361)++runProver :: (Fr, Fr) -> IO (RP.RangeProof Fr PA)+runProver input = do+  proofE <- runExceptT $ RP.generateProof upperBound input+  case proofE of+    Left err -> panic $ "Prover encountered error: " <> show err+    Right proof -> pure proof++prepareProof :: IO (PA, RP.RangeProof Fr PA)+prepareProof = do+  let cm = uncurry Utils.commit rangeInput+  proofObj <- runProver rangeInput+  pure (cm, proofObj)++verify :: PA -> RP.RangeProof Fr PA -> Bool+verify = RP.verifyProof upperBound++benchmark :: [Benchmark]+benchmark+  = [ bench "Proving" $ nfAppIO runProver rangeInput+    , env prepareProof $ \ ~(cm, proofObj) ->+        bench "Verifying" $ nf (uncurry $ RP.verifyProof upperBound) (cm, proofObj)+    ]

@@ -1,43 +1,15 @@-{-# 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)-    ]+import qualified Bench.RangeProof as RP+import qualified Bench.ArithCircuit as AC  main :: IO () main = defaultMain-  [ bgroup "Rangeproof" rangeproofBenchmarks ]+  [ bgroup "Rangeproof" RP.benchmark+  , bgroup "Arithmetic circuit" AC.benchmark+  ]

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 8d64db9eb665557111c118de02a106cc7b0671597707d1314eba6f33cfbe9dd6+-- hash: 16d45f7ae16516008d022e75c558b663bfc2f66f22e0c0acbbb35c6a163b0f7b  name:           bulletproofs-version:        1.0.1+version:        1.1.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@@ -26,8 +26,6 @@  library   exposed-modules:-      Bulletproofs.Curve-      Bulletproofs.Fq       Bulletproofs.RangeProof       Bulletproofs.RangeProof.Internal       Bulletproofs.RangeProof.Prover@@ -48,45 +46,76 @@       Paths_bulletproofs   hs-source-dirs:       ./.-  default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances ExplicitForAll RankNTypes DataKinds KindSignatures GeneralizedNewtypeDeriving TypeApplications ExistentialQuantification ScopedTypeVariables DeriveGeneric BangPatterns FlexibleContexts+  default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances ExplicitForAll TypeApplications ScopedTypeVariables DeriveGeneric BangPatterns FlexibleContexts+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wredundant-constraints -Wno-unused-matches -Wno-name-shadowing -Wno-type-defaults -Wno-orphans -Wno-incomplete-uni-patterns -Wno-incomplete-patterns   build-depends:       MonadRandom     , QuickCheck+    , SHA     , arithmoi >=0.8     , base >=4.7 && <5+    , bytestring     , containers-    , cryptonite-    , galois-field ==0.4.0+    , elliptic-curve >=0.3 && <0.4+    , galois-field >=1 && <2     , memory     , protolude >=0.2-    , random-shuffle     , text   default-language: Haskell2010 +executable bulletproofs-example+  main-is: Main.hs+  other-modules:+      Example.ArithmeticCircuit+      Example.RangeProof+      Paths_bulletproofs+  hs-source-dirs:+      example+  default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances ExplicitForAll TypeApplications ScopedTypeVariables DeriveGeneric BangPatterns FlexibleContexts+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wredundant-constraints -Wno-unused-matches -Wno-name-shadowing -Wno-type-defaults -Wno-orphans -Wno-incomplete-uni-patterns -Wno-incomplete-patterns -O2+  build-depends:+      MonadRandom+    , QuickCheck+    , SHA+    , arithmoi >=0.8+    , base >=4.7 && <5+    , bulletproofs+    , bytestring+    , containers+    , elliptic-curve >=0.3 && <0.4+    , galois-field >=1 && <2+    , memory+    , protolude >=0.2+    , text+  default-language: Haskell2010+ test-suite bulletproofs-test   type: exitcode-stdio-1.0-  main-is: TestDriver.hs+  main-is: Main.hs   other-modules:-      TestArithCircuitProtocol-      TestCommon-      TestField-      TestProtocol+      Test.Common+      Test.Field+      Test.Protocol.ArithCircuit+      Test.Protocol.RangeProof       Paths_bulletproofs   hs-source-dirs:-      tests-  default-extensions: OverloadedStrings NoImplicitPrelude+      test+  default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances ExplicitForAll TypeApplications ScopedTypeVariables DeriveGeneric BangPatterns FlexibleContexts+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wredundant-constraints -Wno-unused-matches -Wno-name-shadowing -Wno-type-defaults -Wno-orphans -Wno-incomplete-uni-patterns -Wno-incomplete-patterns   build-depends:       MonadRandom     , QuickCheck+    , SHA     , arithmoi >=0.8     , base     , bulletproofs+    , bytestring     , containers     , cryptonite-    , galois-field ==0.4.0+    , elliptic-curve >=0.3 && <0.4+    , galois-field >=1 && <2     , memory     , protolude >=0.2-    , random-shuffle     , tasty     , tasty-discover     , tasty-hunit@@ -94,26 +123,31 @@     , text   default-language: Haskell2010 -benchmark rangeproof-benchmarks+benchmark bulletproofs-benchmarks   type: exitcode-stdio-1.0   main-is: Main.hs   other-modules:+      Bench.ArithCircuit+      Bench.RangeProof       Paths_bulletproofs   hs-source-dirs:       bench+  default-extensions: LambdaCase RecordWildCards OverloadedStrings NoImplicitPrelude FlexibleInstances ExplicitForAll TypeApplications ScopedTypeVariables DeriveGeneric BangPatterns FlexibleContexts+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wredundant-constraints -Wno-unused-matches -Wno-name-shadowing -Wno-type-defaults -Wno-orphans -Wno-incomplete-uni-patterns -Wno-incomplete-patterns   build-depends:       MonadRandom     , QuickCheck+    , SHA     , arithmoi >=0.8     , base >=4.7 && <5     , bulletproofs+    , bytestring     , containers     , criterion >=1.5.1.0-    , cryptonite-    , galois-field ==0.4.0+    , elliptic-curve >=0.3 && <0.4+    , galois-field >=1 && <2     , memory     , protolude >=0.2-    , random-shuffle     , tasty     , tasty-hunit     , tasty-quickcheck

@@ -0,0 +1,68 @@+module Example.ArithmeticCircuit where++import Protolude++import Data.Curve.Weierstrass.SECP256K1 (Fr)+import Data.Field.Galois (rnd)++import Bulletproofs.ArithmeticCircuit+import Bulletproofs.Utils (hadamard, commit)++--  Example:+--  2 linear constraints (q = 2):+--  aL[0] + aL[1] + aL[2] + aL[3] = v[0]+--  aR[0] + aR[1] + aR[2] + aR[3] = v[1]+--+--  4 multiplication constraints (implicit) (n = 4):+--  aL[0] * aR[0] = aO[0]+--  aL[1] * aR[1] = aO[1]+--  aL[2] * aR[2] = aO[2]+--  aL[3] * aR[3] = aO[3]+--+--  2 input values (m = 2)++arithCircuitExample :: ArithCircuit Fr+arithCircuitExample = ArithCircuit+  { weights = GateWeights+    { wL = [[1, 1, 1, 1]+           ,[0, 0, 0, 0]]+    , wR = [[0, 0, 0, 0]+           ,[1, 1, 1, 1]]+    , wO = [[0, 0, 0, 0]+           ,[0, 0, 0, 0]]+    }+  , commitmentWeights = [[1, 0]+                        ,[0, 1]]+  , cs = [0, 0]+  }++testArithCircuitProof :: ([Fr], [Fr]) -> ArithCircuit Fr -> IO Bool+testArithCircuitProof (aL, aR) arithCircuit = do+  let m = 2++  -- Multiplication constraints+  let aO = aL `hadamard` aR++  -- Linear constraints+      v0 = sum aL+      v1 = sum aR++  commitBlinders <- replicateM m rnd+  let commitments = zipWith commit [v0, v1] commitBlinders++  let arithWitness = ArithWitness+        { assignment = Assignment aL aR aO+        , commitments = commitments+        , commitBlinders = commitBlinders+        }++  proof <- generateProof arithCircuit arithWitness++  pure $ verifyProof commitments proof arithCircuit++runExample :: IO ()+runExample = do+  let aL = [1,2,3,4]+      aR = [5,6,7,8]+  proof <- testArithCircuitProof (aL, aR) arithCircuitExample+  putText $ "Arimetic circuit proof success: " <> show proof

@@ -0,0 +1,50 @@+module Example.RangeProof where++import Protolude+import Control.Monad.Random (MonadRandom, getRandomR)+import Data.Curve.Weierstrass.SECP256K1 (Fr)+import Data.Field.Galois (rnd)++import qualified Bulletproofs.RangeProof as RP+import qualified Bulletproofs.MultiRangeProof as MRP+import Bulletproofs.Utils (commit)++testSingleRangeProof :: Integer -> (Fr, Fr) -> IO Bool+testSingleRangeProof upperBound (v, vBlinding) = do+  let vCommit = commit v vBlinding+  -- Prover+  proofE <- runExceptT $ RP.generateProof upperBound (v, vBlinding)+  -- Verifier+  case proofE of+    Left err -> panic $ show err+    Right proof@RP.RangeProof{..}+      -> pure $ RP.verifyProof upperBound vCommit proof++testMultiRangeProof :: Integer -> [(Fr, Fr)] -> IO Bool+testMultiRangeProof upperBound vsAndvBlindings = do+  let vCommits = fmap (uncurry commit) vsAndvBlindings+  -- Prover+  proofE <- runExceptT $ MRP.generateProof upperBound vsAndvBlindings+  -- Verifier+  case proofE of+    Left err -> panic $ show err+    Right proof@RP.RangeProof{..}+      -> pure $ MRP.verifyProof upperBound vCommits proof++setupV :: MonadRandom m => Integer -> m (Fr, Fr)+setupV n = do+  v <- fromInteger <$> getRandomR (1, 2^n - 1) -- value that needs to be in a certain range+  vBlinding <- rnd -- blinding value+  pure (v, vBlinding)++runExamples :: IO ()+runExamples = do+  n <- (2 ^) <$> getRandomR (0 :: Integer, 7)+  let upperBound = 2 ^ n+  (v, vBlinding) <- setupV n+  singleRangeProof <- testSingleRangeProof upperBound (v, vBlinding)+  putText $ "Single-range proof success: " <> show singleRangeProof+  vsAndvBlindings <- replicateM 5 (setupV n)+  testMultiRangeProof <- testMultiRangeProof upperBound vsAndvBlindings+  putText $ "Multi-range proof success: " <> show singleRangeProof+

@@ -0,0 +1,11 @@+module Main where++import Protolude++import qualified Example.ArithmeticCircuit as AC+import qualified Example.RangeProof as RP++main :: IO ()+main = do+  RP.runExamples+  AC.runExample

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --tree-display #-}

@@ -0,0 +1,53 @@+module Test.Common+  ( commutes+  , associates+  , isIdentity+  , isInverse+  , distributes+  ) where++import Protolude++commutes+  :: Eq a+  => (a -> a -> a)+  -> a -> a -> Bool+commutes op x y+  = (x `op` y) == (y `op` x)++associates+  :: Eq a+  => (a -> a -> a)+  -> a -> a -> a -> Bool+associates op x y z+  = (x `op` (y `op` z)) == ((x `op` y) `op` z)++isIdentity+  :: Eq a+  => (a -> a -> a)+  -> a+  -> a+  -> Bool+isIdentity op e x+  = (x `op` e == x) && (e `op` x == x)++isInverse+  :: Eq a+  => (a -> a -> a)+  -> (a -> a)+  -> a+  -> a+  -> Bool+isInverse op inv e x+  = (x `op` inv x == e) && (inv x `op` x == e)++distributes+ :: Eq a+ => (a -> a -> a)+ -> (a -> a -> a)+ -> a+ -> a+ -> a+ -> Bool+distributes mult add x y z+  = x `mult` (y `add` z) == (x `mult` y) `add` (x `mult` z)

@@ -0,0 +1,71 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Field where++import Protolude++import Test.Tasty+import Test.Tasty.QuickCheck++import Data.Curve.Weierstrass.SECP256K1 (Fr, PA)+import Data.Curve.Weierstrass++import Test.Common++prop_addMod :: Fr -> Fr -> Property+prop_addMod x y+  = left === right+  where+    left :: PA+    left = gen `mul` (x + y)++    right :: PA+    right = (gen `mul` x) `add` (gen `mul` y)++prop_subMod :: Fr -> Fr -> Property+prop_subMod x y+  = left === right+  where+    left :: PA+    left = gen `mul` (x - y)++    right :: PA+    right = (gen `mul` x) `add` inv (gen `mul` y)++-------------------------------------------------------------------------------+-- Laws of field operations+-------------------------------------------------------------------------------++testFieldLaws+  :: forall a . (Fractional a, Eq a, Arbitrary a, Show a)+  => Proxy a+  -> TestName+  -> TestTree+testFieldLaws _ descr+  = testGroup ("Test field laws of " <> descr)+    [ testProperty "commutativity of addition"+      $ commutes ((+) :: a -> a -> a)+    , testProperty "commutativity of multiplication"+      $ commutes ((*) :: a -> a -> a)+    , testProperty "associavity of addition"+      $ associates ((+) :: a -> a -> a)+    , testProperty "associavity of multiplication"+      $ associates ((*) :: a -> a -> a)+    , testProperty "additive identity"+      $ isIdentity ((+) :: a -> a -> a) 0+    , testProperty "multiplicative identity"+      $ isIdentity ((*) :: a -> a -> a) 1+    , testProperty "additive inverse"+      $ isInverse ((+) :: a -> a -> a) negate 0+    , testProperty "multiplicative inverse"+      $ \x -> (x /= (0 :: a)) ==> isInverse ((*) :: a -> a -> a) recip 1 x+    , testProperty "multiplication distributes over addition"+      $ distributes ((*) :: a -> a -> a) (+)+    ]++-------------------------------------------------------------------------------+-- Fq+-------------------------------------------------------------------------------++test_fieldLaws_Fq :: TestTree+test_fieldLaws_Fq = testFieldLaws (Proxy :: Proxy Fr) "Fr"

@@ -0,0 +1,208 @@+{-# LANGUAGE ViewPatterns, RecordWildCards, TypeApplications  #-}++module Test.Protocol.ArithCircuit where++import Protolude++import Test.Tasty+import Test.Tasty.QuickCheck+import qualified Test.QuickCheck.Monadic as QCM++import Data.Curve.Weierstrass.SECP256K1 (Fr)++import Bulletproofs.Utils+import Bulletproofs.ArithmeticCircuit+import Bulletproofs.ArithmeticCircuit.Internal++-- | Test an arbitrary circuit+-- Construction:+-- 1. aL, aR, aO; wL, wR, wO; c+--    such that wL * aL + wR * aR + wO * aO = c+--+-- 2. Create wV and v to+--      - reduce the size of the prove (m <= n)+--      - hide assignment+--    wL * aL + wR * aR + wO * aO - c = wV * v+test_arithCircuitProof_arbitrary :: TestTree+test_arithCircuitProof_arbitrary = localOption (QuickCheckTests 10) $+  testProperty "Arbitrary arithmetic circuit proof" $ go+  where+    go :: Property+    go = forAll (arbitrary `suchThat` ((<) 100))+         $ \n -> forAll (arbitrary `suchThat` (\m -> m > 0 && m < n))+         $ \m -> forAll (arithCircuitGen n m)+         $ \arithCircuit@ArithCircuit{..} -> forAll (arithAssignmentGen n)+         $ \assignment@Assignment{..} -> forAll (arithWitnessGen assignment arithCircuit m)+         $ \arithWitness@ArithWitness{..} -> QCM.monadicIO $ do+      proof <- QCM.run $ generateProof arithCircuit arithWitness+      QCM.assert $ verifyProof commitments proof arithCircuit++-- | Test hadamard product relation+--  2 linear constraints (q = 2):+--  aL[0] + aL[1] + ... + aL[15] = v[0]+--  aR[0] + aR[1] + ... + aR[15] = v[1]+--+--  16 multiplication constraints (implicit) (n = 16):+--+--  2 input values (m = 2)+test_arithCircuitProof_hadamard :: TestTree+test_arithCircuitProof_hadamard = localOption (QuickCheckTests 20) $+  testProperty "Arithmetic circuit proof. Hadamard product relation" go+  where+    n = 16+    go :: Fr -> Fr -> Property+    go r s = forAll (vectorOf n (arbitrary @Fr))+        $ \aL -> forAll (vectorOf n arbitrary)+        $ \aR -> QCM.monadicIO $ do+      let aO = aL `hadamard` aR++      let v0 = sum aL+          v1 = sum aR++      let v0Commit = commit v0 r+          v1Commit = commit v1 s++      let zeroVector = replicate (fromIntegral n) 0+          oneVector = replicate (fromIntegral n) 1++      let wL = [oneVector, zeroVector]+          wR = [zeroVector, oneVector]+          wO = [zeroVector, zeroVector]++          commitmentWeights = [[1, 0], [0, 1]]+          cs = [0, 0]+          commitments = [v0Commit, v1Commit]+          commitBlinders = [r, s]+          gateWeights = GateWeights wL wR wO+          gateInputs = Assignment aL aR aO+          arithCircuit = ArithCircuit gateWeights commitmentWeights cs+          arithWitness = ArithWitness gateInputs commitments commitBlinders++      proof <- QCM.run $ generateProof arithCircuit arithWitness++      QCM.assert $ verifyProof commitments proof arithCircuit++-- | Test that an addition circuit without multiplication gates succeeds+--  1 linear constraints (q = 1):+--  v[0] + v[1] = v[2]+--+--  0 multiplication constraints (implicit) (n = 0):+--+--  3 input values (m = 3)+test_arithCircuitProof_no_mult_gates :: TestTree+test_arithCircuitProof_no_mult_gates = localOption (QuickCheckTests 20) $+  testProperty "Arithmetic circuit proof. n = 0, m = 3, q = 1" go+  where+    m = 3+    go :: Property+    go = forAll (vectorOf (fromIntegral m) (arbitrary @Fr))+         $ \commitBlinders -> QCM.monadicIO $ do+      let wL = [[]]+          wR = [[]]+          wO = [[]]+          cs = [0]+          aL = []+          aR = []+          aO = []+          commitmentWeights = [[1, 1, -1]]+          vs = [2, 5, 7]+          commitments = zipWith commit vs commitBlinders+          gateWeights = GateWeights wL wR wO+          gateInputs = Assignment aL aR aO+          arithCircuit = ArithCircuit gateWeights commitmentWeights cs+          arithWitness = ArithWitness gateInputs commitments commitBlinders++      proof <- QCM.run $ generateProof arithCircuit arithWitness++      QCM.assert $ verifyProof commitments proof arithCircuit++--  | Test that a circuit with a single multiplication gate+--  with linear contraints and not committed values succeeds+--  3 linear constraints (q = 3):+--  aL[0] = 3+--  aR[0] = 4+--  aO[0] = 9+--+--  1 multiplication constraint (implicit) (n = 1):+--  aL[0] * aR[0] = aO[0]+--+--  0 input values (m = 0)+test_arithCircuitProof_no_input_values :: TestTree+test_arithCircuitProof_no_input_values = localOption (QuickCheckTests 20) $+  testProperty "Arithmetic circuit proof. n = 1, m = 0, q = 3" go+  where+    m = 0+    go :: Property+    go = forAll (vectorOf (fromIntegral m) (arbitrary @Fr))+         $ \commitBlinders -> QCM.monadicIO $ do+      let wL = [[0], [0], [1]]+          wR = [[0], [1], [0]]+          wO = [[1], [0], [0]]+          cs = [35, 5, 7]+          aL = [7]+          aR = [5]+          aO = [35]+          commitmentWeights = [[], [], []]+          vs = []+          commitments = zipWith commit vs commitBlinders+          gateWeights = GateWeights wL wR wO+          gateInputs = Assignment aL aR aO+          arithCircuit = ArithCircuit gateWeights commitmentWeights cs+          arithWitness = ArithWitness gateInputs commitments commitBlinders+      proof <- QCM.run $ generateProof arithCircuit arithWitness+      QCM.assert $ verifyProof commitments proof arithCircuit++--  5 linear constraints (q = 5):+--  aO[0] = aO[1]+--  aL[0] = V[0] - z+--  aL[1] = V[2] - z+--  aR[0] = V[1] - z+--  aR[1] = V[3] - z+--+--  2 multiplication constraint (implicit) (n = 2):+--  aL[0] * aR[0] = aO[0]+--  aL[1] * aR[1] = aO[1]+--+--  4 input values (m = 4)+test_arithCircuitProof_shuffle_circuit :: TestTree+test_arithCircuitProof_shuffle_circuit = localOption (QuickCheckTests 20) $+  testProperty "Arithmetic circuit proof. n = 2, m = 4, q = 5" $ go+  where+    go :: Fr -> Property+    go z = forAll (vectorOf 4 (arbitrary @Fr))+        $ \commitBlinders -> QCM.monadicIO $ do++      let wL = [[0, 0]+               ,[1, 0]+               ,[0, 1]+               ,[0, 0]+               ,[0, 0]]+          wR = [[0, 0]+               ,[0, 0]+               ,[0, 0]+               ,[1, 0]+               ,[0, 1]]+          wO = [[1, -1]+               ,[0, 0]+               ,[0, 0]+               ,[0, 0]+               ,[0, 0]]+          wV = [[0, 0, 0, 0]+               ,[1, 0, 0, 0]+               ,[0, 0, 1, 0]+               ,[0, 1, 0 ,0]+               ,[0, 0, 0, 1]]+          cs = [0, -z, -z, -z, -z]+          aL = [4 - z, 9 - z]+          aR = [9 - z, 4 - z]+          aO = aL `hadamard` aR+          vs = [4, 9, 9, 4]+          commitments = zipWith commit vs commitBlinders+          gateWeights = GateWeights wL wR wO+          gateInputs = Assignment aL aR aO+          arithCircuit = ArithCircuit gateWeights wV cs+          arithWitness = ArithWitness gateInputs commitments commitBlinders++      proof <- QCM.run $ generateProof arithCircuit arithWitness+      QCM.assert $ verifyProof commitments proof arithCircuit+

@@ -0,0 +1,223 @@+{-# LANGUAGE ViewPatterns, RecordWildCards, ScopedTypeVariables  #-}++module Test.Protocol.RangeProof where++import Protolude++import Test.Tasty+import Test.Tasty.QuickCheck+import qualified Test.QuickCheck.Monadic as QCM++import Control.Monad.Random (MonadRandom, getRandomR)+import Data.Field.Galois (PrimeField(..), rnd)+import Data.Curve.Weierstrass.SECP256K1 (Fr, PA, _r)++import qualified Bulletproofs.RangeProof as RP+import qualified Bulletproofs.RangeProof.Internal as RP+import qualified Bulletproofs.MultiRangeProof as MRP+import qualified Bulletproofs.MultiRangeProof.Verifier as MRP+import Bulletproofs.Utils++newtype Bin = Bin { unbin :: Int } deriving Show++instance Arbitrary Bin where+  arbitrary = Bin <$> arbitrary `suchThat` flip elem [0,1]++getUpperBound :: Integer -> Integer+getUpperBound n = 2 ^ n++prop_complementaryVector_dot :: [Bin] -> Property+prop_complementaryVector_dot ((unbin <$>) -> xs)+  = dot xs (RP.complementaryVector xs) === 0++prop_complementaryVector_hadamard :: [Bin] -> Property+prop_complementaryVector_hadamard ((toInteger . unbin <$>) -> xs)+  = hadamard xs (RP.complementaryVector xs) === replicate (length xs) 0++prop_dot_aL2n :: Property+prop_dot_aL2n = QCM.monadicIO $ do+  n <- QCM.run $ (2 ^) <$> getRandomR (0 :: Integer, 7)+  v <- QCM.run $ fromInteger <$> randomN n+  QCM.assert $ RP.reversedEncodeBit n v `dot` powerVector 2 n == v++prop_challengeComplementaryVector :: Property+prop_challengeComplementaryVector = QCM.monadicIO $ do+  n <- QCM.run $ (2 ^) <$> getRandomR (0 :: Integer, 7)+  v <- QCM.run $ fromInteger <$> randomN n+  let aL = RP.reversedEncodeBit n v+      aR = RP.complementaryVector aL+  y <- QCM.run $ fromInteger <$> randomN n+  QCM.assert+    $ dot+      ((aL ^-^ powerVector 1 n) ^-^ aR)+      (powerVector y n)+      ==+      0++prop_reversedEncodeBitAggr :: Int -> Property+prop_reversedEncodeBitAggr x = QCM.monadicIO $ do+  n <- QCM.run $ (2 ^) <$> getRandomR (0 :: Integer, 7)+  vs <- QCM.run $ ((<$>) fromInteger) <$> replicateM x (randomN n)+  let m = fromIntegral $ length vs+      reversed = RP.reversedEncodeBitMulti n vs+  QCM.assert $ vs == fmap (\j -> dot (slice n j reversed) (powerVector 2 n)) [1..m]++prop_challengeComplementaryVectorAggr :: Int -> Property+prop_challengeComplementaryVectorAggr x = QCM.monadicIO $ do+  n <- QCM.run $ (2 ^) <$> getRandomR (0 :: Integer, 7)+  vs <- QCM.run $ ((<$>) fromInteger) <$> replicateM 3 (randomN n)+  let aL = RP.reversedEncodeBitMulti n vs+      aR = RP.complementaryVector aL+      m = length vs+  y <- QCM.run $ fromInteger <$> randomN n+  QCM.assert $+    replicate m 0+    ==+    fmap (\j -> dot ((slice n j aL ^-^ powerVector 1 n) ^-^ slice n j aR) (powerVector y n)) [1..fromIntegral m]++prop_obfuscateEncodedBits+  :: Fr+  -> Fr+  -> Property+prop_obfuscateEncodedBits y z+  = QCM.monadicIO $ do+  n <- QCM.run $ (2 ^) <$> getRandomR (0 :: Integer, 7)+  v <- QCM.run $ fromInteger <$> randomN n+  let aL = RP.reversedEncodeBit n v+      aR = RP.complementaryVector aL++  QCM.assert $ RP.obfuscateEncodedBits n aL aR y z == (z ^ 2) * v++prop_singleInnerProduct+  :: Fr+  -> Fr+  -> Property+prop_singleInnerProduct y z+  = QCM.monadicIO $ do+  n <- QCM.run $ (2 ^) <$> getRandomR (0 :: Integer, 7)+  v <- QCM.run $ fromInteger <$> randomN n++  let aL = RP.reversedEncodeBit n v+      aR = RP.complementaryVector aL++  QCM.assert $ RP.obfuscateEncodedBitsSingle n aL aR y z == ((z ^ 2) * v) + RP.delta n 1 y z++setupV :: MonadRandom m => Integer -> m ((Fr, Fr), PA)+setupV n = do+  v <- fromInteger <$> getRandomR (0, 2^n - 1)+  vBlinding <- rnd+  let vCommit = commit v vBlinding+  pure ((v, vBlinding), vCommit)++test_verifyTPolynomial :: TestTree+test_verifyTPolynomial = localOption (QuickCheckTests 5) $+  testProperty "Verify T polynomial" $ QCM.monadicIO $ do+    n <- QCM.run $ (2 ^) <$> getRandomR (0 :: Integer, 7)+    m <- QCM.run $ (2 ^) <$> getRandomR (0 :: Integer, 3)+    ctx <- QCM.run $ replicateM m (setupV n)++    proofE <- QCM.run $ runExceptT $ MRP.generateProof (getUpperBound n) (fst <$> ctx)+    case proofE of+      Left err -> panic $ show err+      Right (proof@RP.RangeProof{..}) -> do+        let x, y, z :: Fr+            x = shamirX aCommit sCommit t1Commit t2Commit y z+            y = shamirY aCommit sCommit+            z = shamirZ aCommit sCommit y+        QCM.assert $ MRP.verifyTPoly n (snd <$> ctx) proof x y z++test_verifyLRCommitments :: TestTree+test_verifyLRCommitments = localOption (QuickCheckTests 5) $+  testProperty "Verify LR commitments" $ QCM.monadicIO $ do+    n <- QCM.run $ (2 ^) <$> getRandomR (0 :: Integer, 7)+    m <- QCM.run $ (2 ^) <$> getRandomR (0 :: Integer, 3)+    ctx <- QCM.run $ replicateM (fromIntegral m) (setupV n)++    proofE <- QCM.run $ runExceptT $ MRP.generateProof (getUpperBound n) (fst <$> ctx)+    case proofE of+      Left err -> panic $ show err+      Right (proof@RP.RangeProof{..}) -> do+        let x, y, z :: Fr+            x = shamirX aCommit sCommit t1Commit t2Commit y z+            y = shamirY aCommit sCommit+            z = shamirZ aCommit sCommit y++        QCM.assert $ MRP.verifyLRCommitment n m proof x y z++prop_valueNotInRange :: Property+prop_valueNotInRange = QCM.monadicIO $ do+  n <- QCM.run $ (2 ^) <$> getRandomR (0 :: Integer, 7)+  ((v, vBlinding), vCommit) <- QCM.run $ setupV n+  let upperBound = getUpperBound n+      vNotInRange = fromInteger (fromP v + upperBound)++  proofE <- QCM.run $ runExceptT $ MRP.generateProof upperBound [(vNotInRange, vBlinding)]+  case proofE of+    Left err ->+      QCM.assert $ RP.ValuesNotInRange [vNotInRange] == err+    Right (proof@RP.RangeProof{..}) ->+      QCM.assert $ MRP.verifyProof upperBound [vCommit] proof++prop_invalidUpperBound :: Property+prop_invalidUpperBound = QCM.monadicIO $ do+  n <- QCM.run $ (2 ^) <$> getRandomR (0 :: Integer, 7)+  ((v, vBlinding), vCommit) <- QCM.run $ setupV n+  let invalidUpperBound = fromIntegral $ _r + 1+  proofE <- QCM.run $ runExceptT $ MRP.generateProof invalidUpperBound [(v, vBlinding)]+  case proofE of+    Left err ->+      QCM.assert $ RP.UpperBoundTooLarge invalidUpperBound == err+    Right (proof@RP.RangeProof{..}) ->+      QCM.assert $ MRP.verifyProof invalidUpperBound [vCommit] proof++prop_differentUpperBound :: Positive Integer -> Property+prop_differentUpperBound (Positive upperBound') = expectFailure . QCM.monadicIO $ do+  n <- QCM.run $ (2 ^) <$> getRandomR (0 :: Integer, 7)+  ((v, vBlinding), vCommit) <- QCM.run $ setupV n+  proofE <- QCM.run $ runExceptT $ MRP.generateProof (getUpperBound n) [(v, vBlinding)]+  case proofE of+    Left err -> panic $ show err+    Right (proof@RP.RangeProof{..}) ->+      QCM.assert $ MRP.verifyProof upperBound' [vCommit] proof++test_invalidCommitment :: TestTree+test_invalidCommitment = localOption (QuickCheckTests 20) $+  testProperty "Check invalid commitment" $ QCM.monadicIO $ do+  n <- QCM.run $ (2 ^) <$> getRandomR (0 :: Integer, 7)+  ((v, vBlinding), vCommit) <- QCM.run $ setupV n+  let invalidVCommit = commit (v + 1) vBlinding+      upperBound = getUpperBound n+  proofE <- QCM.run $ runExceptT $ MRP.generateProof upperBound [(v, vBlinding)]+  case proofE of+    Left err -> panic $ show err+    Right (proof@(RP.RangeProof{..})) ->+      QCM.assert $ not $ MRP.verifyProof upperBound [invalidVCommit] proof++test_multiRangeProof_completeness :: TestTree+test_multiRangeProof_completeness = localOption (QuickCheckTests 5) $+  testProperty "Test multi range proof completeness" $ QCM.monadicIO $ do+    n <- QCM.run $ (2 ^) <$> getRandomR (0 :: Integer, 7)+    m <- QCM.run $ getRandomR (1 :: Integer, 10)+    ctx <- QCM.run $ replicateM (fromIntegral m) (setupV n)+    let upperBound = getUpperBound n++    proofE <- QCM.run $ runExceptT $ MRP.generateProof (getUpperBound n) (fst <$> ctx)+    case proofE of+      Left err -> panic $ show err+      Right (proof@RP.RangeProof{..}) ->+        QCM.assert $ MRP.verifyProof upperBound (snd <$> ctx) proof++test_singleRangeProof_completeness :: TestTree+test_singleRangeProof_completeness = localOption (QuickCheckTests 20) $+  testProperty "Test single range proof completeness" $ QCM.monadicIO $ do+    n <- QCM.run $ (2 ^) <$> getRandomR (0 :: Integer, 7)+    ((v, vBlinding), vCommit) <- QCM.run $ setupV n+    let upperBound = getUpperBound n++    proofE <- QCM.run $ runExceptT $ RP.generateProof (getUpperBound n) (v, vBlinding)+    case proofE of+      Left err -> panic $ show err+      Right (proof@RP.RangeProof{..}) ->+        QCM.assert $ RP.verifyProof upperBound vCommit proof++

@@ -1,220 +0,0 @@-{-# LANGUAGE ViewPatterns, RecordWildCards, TypeApplications  #-}--module TestArithCircuitProtocol where--import Protolude--import qualified Data.Map as Map-import qualified Data.List as List--import Test.Tasty-import Test.Tasty.QuickCheck-import Test.QuickCheck-import qualified Test.QuickCheck.Monadic as QCM--import Crypto.Number.Generate (generateMax, generateBetween)-import Control.Monad.Random (MonadRandom)--import qualified Bulletproofs.InnerProductProof as IPP-import qualified Bulletproofs.Fq as Fq-import Bulletproofs.Utils-import Bulletproofs.Curve-import Bulletproofs.Fq-import Bulletproofs.ArithmeticCircuit-import Bulletproofs.ArithmeticCircuit.Internal---- | Test an arbitrary circuit--- Construction:--- 1. aL, aR, aO; wL, wR, wO; c---    such that wL * aL + wR * aR + wO * aO = c------ 2. Create wV and v to---      - reduce the size of the prove (m <= n)---      - hide assignment---    wL * aL + wR * aR + wO * aO - c = wV * v-test_arithCircuitProof_arbitrary :: TestTree-test_arithCircuitProof_arbitrary = localOption (QuickCheckTests 10) $-  testProperty "Arbitrary arithmetic circuit proof" $ go-  where-    go :: Property-    go = forAll (arbitrary `suchThat` ((<) 100))-         $ \n -> forAll (arbitrary `suchThat` (\m -> m > 0 && m < n))-         $ \m -> forAll (arithCircuitGen @(PF Fq) n m)-         $ \arithCircuit@ArithCircuit{..} -> forAll (arithAssignmentGen n)-         $ \assignment@Assignment{..} -> forAll (arithWitnessGen assignment arithCircuit m)-         $ \arithWitness@ArithWitness{..} -> QCM.monadicIO $ do-      proof <- QCM.run $ generateProof arithCircuit arithWitness-      QCM.assert $ verifyProof commitments proof arithCircuit---- | Test hadamard product relation---  2 linear constraints (q = 2):---  aL[0] + aL[1] + ... + aL[15] = v[0]---  aR[0] + aR[1] + ... + aR[15] = v[1]------  16 multiplication constraints (implicit) (n = 16):------  2 input values (m = 2)-test_arithCircuitProof_hadamardp :: TestTree-test_arithCircuitProof_hadamardp = localOption (QuickCheckTests 20) $-  testProperty "Arithmetic circuit proof. Hadamard product relation" go-  where-    n = 16-    go :: Fq -> Fq -> Property-    go r s = forAll (vectorOf n (arbitrary @Fq))-        $ \aL -> forAll (vectorOf n arbitrary)-        $ \aR -> QCM.monadicIO $ do-      let aO = aL `hadamardp` aR--      let v0 = sum aL-          v1 = sum aR--      let v0Commit = commit v0 r-          v1Commit = commit v1 s--      let zeroVector = replicate (fromIntegral n) 0-          oneVector = replicate (fromIntegral n) 1--      let wL = [oneVector, zeroVector]-          wR = [zeroVector, oneVector]-          wO = [zeroVector, zeroVector]--          commitmentWeights = [[1, 0], [0, 1]]-          cs = [0, 0]-          commitments = [v0Commit, v1Commit]-          commitBlinders = [r, s]-          gateWeights = GateWeights wL wR wO-          gateInputs = Assignment aL aR aO-          arithCircuit = ArithCircuit gateWeights commitmentWeights cs-          arithWitness = ArithWitness gateInputs commitments commitBlinders--      proof <- QCM.run $ generateProof arithCircuit arithWitness--      QCM.assert $ verifyProof commitments proof arithCircuit---- | Test that an addition circuit without multiplication gates succeeds---  1 linear constraints (q = 1):---  v[0] + v[1] = v[2]------  0 multiplication constraints (implicit) (n = 0):------  3 input values (m = 3)-test_arithCircuitProof_no_mult_gates :: TestTree-test_arithCircuitProof_no_mult_gates = localOption (QuickCheckTests 20) $-  testProperty "Arithmetic circuit proof. n = 0, m = 3, q = 1" go-  where-    m = 3-    go :: Property-    go = forAll (vectorOf (fromIntegral m) (arbitrary @Fq))-         $ \commitBlinders -> QCM.monadicIO $ do-      let n = 0-      let wL = [[]]-          wR = [[]]-          wO = [[]]-          cs = [0]-          aL = []-          aR = []-          aO = []-          commitmentWeights = [[1, 1, -1]]-          vs = [2, 5, 7]-          commitments = zipWith commit vs commitBlinders-          gateWeights = GateWeights wL wR wO-          gateInputs = Assignment aL aR aO-          arithCircuit = ArithCircuit gateWeights commitmentWeights cs-          arithWitness = ArithWitness gateInputs commitments commitBlinders--      proof <- QCM.run $ generateProof arithCircuit arithWitness--      QCM.assert $ verifyProof commitments proof arithCircuit----  | Test that a circuit with a single multiplication gate---  with linear contraints and not committed values succeeds---  3 linear constraints (q = 3):---  aL[0] = 3---  aR[0] = 4---  aO[0] = 9------  1 multiplication constraint (implicit) (n = 1):---  aL[0] * aR[0] = aO[0]------  0 input values (m = 0)-test_arithCircuitProof_no_input_values :: TestTree-test_arithCircuitProof_no_input_values = localOption (QuickCheckTests 20) $-  testProperty "Arithmetic circuit proof. n = 1, m = 0, q = 3" go-  where-    m = 0-    go :: Property-    go = forAll (vectorOf (fromIntegral m) (arbitrary @Fq))-         $ \commitBlinders -> QCM.monadicIO $ do-      let n = 1--      let wL = [[0], [0], [1]]-          wR = [[0], [1], [0]]-          wO = [[1], [0], [0]]-          cs = [35, 5, 7]-          aL = [7]-          aR = [5]-          aO = [35]-          commitmentWeights = [[], [], []]-          vs = []-          commitments = zipWith commit vs commitBlinders-          gateWeights = GateWeights wL wR wO-          gateInputs = Assignment aL aR aO-          arithCircuit = ArithCircuit gateWeights commitmentWeights cs-          arithWitness = ArithWitness gateInputs commitments commitBlinders-      proof <- QCM.run $ generateProof arithCircuit arithWitness-      QCM.assert $ verifyProof commitments proof arithCircuit----  5 linear constraints (q = 5):---  aO[0] = aO[1]---  aL[0] = V[0] - z---  aL[1] = V[2] - z---  aR[0] = V[1] - z---  aR[1] = V[3] - z------  2 multiplication constraint (implicit) (n = 2):---  aL[0] * aR[0] = aO[0]---  aL[1] * aR[1] = aO[1]------  4 input values (m = 4)-test_arithCircuitProof_shuffle_circuit :: TestTree-test_arithCircuitProof_shuffle_circuit = localOption (QuickCheckTests 20) $-  testProperty "Arithmetic circuit proof. n = 2, m = 4, q = 5" $ go-  where-    go :: Fq -> Property-    go z = forAll (vectorOf 4 (arbitrary @Fq))-        $ \commitBlinders -> QCM.monadicIO $ do--      let wL = [[0, 0]-               ,[1, 0]-               ,[0, 1]-               ,[0, 0]-               ,[0, 0]]-          wR = [[0, 0]-               ,[0, 0]-               ,[0, 0]-               ,[1, 0]-               ,[0, 1]]-          wO = [[1, -1]-               ,[0, 0]-               ,[0, 0]-               ,[0, 0]-               ,[0, 0]]-          wV = [[0, 0, 0, 0]-               ,[1, 0, 0, 0]-               ,[0, 0, 1, 0]-               ,[0, 1, 0 ,0]-               ,[0, 0, 0, 1]]-          cs = [0, -z, -z, -z, -z]-          aL = [4 - z, 9 - z]-          aR = [9 - z, 4 - z]-          aO = aL `hadamardp` aR-          vs = [4, 9, 9, 4]-          commitments = zipWith commit vs commitBlinders-          gateWeights = GateWeights wL wR wO-          gateInputs = Assignment aL aR aO-          arithCircuit = ArithCircuit gateWeights wV cs-          arithWitness = ArithWitness gateInputs commitments commitBlinders--      proof <- QCM.run $ generateProof arithCircuit arithWitness-      QCM.assert $ verifyProof commitments proof arithCircuit-

@@ -1,53 +0,0 @@-module TestCommon-  ( commutes-  , associates-  , isIdentity-  , isInverse-  , distributes-  ) where--import Protolude--commutes-  :: Eq a-  => (a -> a -> a)-  -> a -> a -> Bool-commutes op x y-  = (x `op` y) == (y `op` x)--associates-  :: Eq a-  => (a -> a -> a)-  -> a -> a -> a -> Bool-associates op x y z-  = (x `op` (y `op` z)) == ((x `op` y) `op` z)--isIdentity-  :: Eq a-  => (a -> a -> a)-  -> a-  -> a-  -> Bool-isIdentity op e x-  = (x `op` e == x) && (e `op` x == x)--isInverse-  :: Eq a-  => (a -> a -> a)-  -> (a -> a)-  -> a-  -> a-  -> Bool-isInverse op inv e x-  = (x `op` inv x == e) && (inv x `op` x == e)--distributes- :: Eq a- => (a -> a -> a)- -> (a -> a -> a)- -> a- -> a- -> a- -> Bool-distributes mult add x y z-  = x `mult` (y `add` z) == (x `mult` y) `add` (x `mult` z)

@@ -1,1 +0,0 @@-{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --tree-display #-}

@@ -1,63 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--module TestField where--import Protolude--import Test.Tasty-import Test.Tasty.QuickCheck-import Test.Tasty.HUnit--import qualified Crypto.PubKey.ECC.Prim as Crypto--import Bulletproofs.Utils-import Bulletproofs.Fq as Fq-import Bulletproofs.Curve--import TestCommon--prop_addMod :: Fq -> Fq -> Property-prop_addMod x y-  = (x + y) `mulP` g === (x `mulP` g) `addP` (y `mulP` g)--prop_subMod :: Fq -> Fq -> Property-prop_subMod x y-  = (x - y) `mulP` g === (x `mulP` g) `addP` Crypto.pointNegate curve (y `mulP` g)------------------------------------------------------------------------------------ Laws of field operations----------------------------------------------------------------------------------testFieldLaws-  :: forall a . (Num a, Fractional a, Eq a, Arbitrary a, Show a)-  => Proxy a-  -> TestName-  -> TestTree-testFieldLaws _ descr-  = testGroup ("Test field laws of " <> descr)-    [ testProperty "commutativity of addition"-      $ commutes ((+) :: a -> a -> a)-    , testProperty "commutativity of multiplication"-      $ commutes ((*) :: a -> a -> a)-    , testProperty "associavity of addition"-      $ associates ((+) :: a -> a -> a)-    , testProperty "associavity of multiplication"-      $ associates ((*) :: a -> a -> a)-    , testProperty "additive identity"-      $ isIdentity ((+) :: a -> a -> a) 0-    , testProperty "multiplicative identity"-      $ isIdentity ((*) :: a -> a -> a) 1-    , testProperty "additive inverse"-      $ isInverse ((+) :: a -> a -> a) negate 0-    , testProperty "multiplicative inverse"-      $ \x -> (x /= (0 :: a)) ==> isInverse ((*) :: a -> a -> a) recip 1 x-    , testProperty "multiplication distributes over addition"-      $ distributes ((*) :: a -> a -> a) (+)-    ]------------------------------------------------------------------------------------ Fq----------------------------------------------------------------------------------test_fieldLaws_Fq :: TestTree-test_fieldLaws_Fq = testFieldLaws (Proxy :: Proxy Fq) "Fq"

@@ -1,235 +0,0 @@-{-# LANGUAGE ViewPatterns, RecordWildCards, TypeApplications, ScopedTypeVariables  #-}--module TestProtocol where--import Protolude--import Test.Tasty-import Test.Tasty.QuickCheck-import Test.QuickCheck-import qualified Test.QuickCheck.Monadic as QCM--import Crypto.Random.Types (MonadRandom(..))-import Crypto.Number.Generate (generateMax, generateBetween)-import qualified Crypto.PubKey.ECC.Generate as Crypto-import qualified Crypto.PubKey.ECC.Prim as Crypto-import qualified Crypto.PubKey.ECC.Types as Crypto-import GaloisField (GaloisField(..))-import PrimeField (toInt)--import Bulletproofs.Curve-import qualified Bulletproofs.RangeProof as RP-import qualified Bulletproofs.RangeProof.Internal as RP-import qualified Bulletproofs.RangeProof.Verifier as RP--import qualified Bulletproofs.MultiRangeProof as MRP-import qualified Bulletproofs.MultiRangeProof.Verifier as MRP--import Bulletproofs.Utils-import Bulletproofs.Fq as Fq--import TestField--newtype Bin = Bin { unbin :: Int } deriving Show--instance Arbitrary Bin where-  arbitrary = Bin <$> arbitrary `suchThat` flip elem [0,1]--getUpperBound :: Integer -> Integer-getUpperBound n = 2 ^ n--prop_complementaryVector_dot :: [Bin] -> Property-prop_complementaryVector_dot ((unbin <$>) -> xs)-  = dot xs (RP.complementaryVector xs) === 0--prop_complementaryVector_hadamard :: [Bin] -> Property-prop_complementaryVector_hadamard ((toInteger . unbin <$>) -> xs)-  = hadamardp xs (RP.complementaryVector xs) === replicate (length xs) 0--prop_dot_aL2n :: Property-prop_dot_aL2n = QCM.monadicIO $ do-  n <- QCM.run $ (2 ^) <$> generateMax 8-  v <- QCM.run $ fromInteger <$> randomN n-  QCM.assert $ RP.reversedEncodeBit @(PF Fq) n v `dot` powerVector 2 n == v--prop_challengeComplementaryVector :: Property-prop_challengeComplementaryVector = QCM.monadicIO $ do-  n <- QCM.run $ (2 ^) <$> generateMax 8-  v <- QCM.run $ fromInteger <$> randomN n-  let aL = RP.reversedEncodeBit @(PF Fq) n v-      aR = RP.complementaryVector aL-  y <- QCM.run $ fromInteger <$> randomN n-  QCM.assert-    $ dot-      ((aL ^-^ powerVector 1 n) ^-^ aR)-      (powerVector y n)-      ==-      0--prop_reversedEncodeBitAggr :: Int -> Property-prop_reversedEncodeBitAggr x = QCM.monadicIO $ do-  n <- QCM.run $ (2 ^) <$> generateMax 8-  vs <- QCM.run $ ((<$>) fromInteger) <$> replicateM x (randomN n)-  let m = fromIntegral $ length vs-      reversed = RP.reversedEncodeBitMulti @(PF Fq) n vs-  QCM.assert $ vs == fmap (\j -> dot (slice n j reversed) (powerVector 2 n)) [1..m]--prop_challengeComplementaryVectorAggr :: Int -> Property-prop_challengeComplementaryVectorAggr x = QCM.monadicIO $ do-  n <- QCM.run $ (2 ^) <$> generateMax 8-  vs <- QCM.run $ ((<$>) fromInteger) <$> replicateM 3 (randomN n)-  let aL = RP.reversedEncodeBitMulti @(PF Fq) n vs-      aR = RP.complementaryVector aL-      m = length vs-  y <- QCM.run $ fromInteger <$> randomN n-  QCM.assert $-    replicate m 0-    ==-    fmap (\j -> dot ((slice n j aL ^-^ powerVector 1 n) ^-^ slice n j aR) (powerVector y n)) [1..fromIntegral m]--prop_obfuscateEncodedBits-  :: Fq-  -> Fq-  -> Property-prop_obfuscateEncodedBits y z-  = QCM.monadicIO $ do-  n <- QCM.run $ (2 ^) <$> generateMax 8-  v <- QCM.run $ fromInteger <$> randomN n-  let aL = RP.reversedEncodeBit n v-      aR = RP.complementaryVector aL--  QCM.assert $ RP.obfuscateEncodedBits n aL aR y z == (z ^ 2) * v--prop_singleInnerProduct-  :: Fq-  -> Fq-  -> Property-prop_singleInnerProduct y z-  = QCM.monadicIO $ do-  n <- QCM.run $ (2 ^) <$> generateMax 8-  v <- QCM.run $ fromInteger <$> randomN n--  let aL = RP.reversedEncodeBit n v-      aR = RP.complementaryVector aL--  QCM.assert $ RP.obfuscateEncodedBitsSingle n aL aR y z == ((z ^ 2) * v) + RP.delta n 1 y z--setupV :: MonadRandom m => Integer -> m ((Fq, Fq), Crypto.Point)-setupV n = do-  v <- fromInteger <$> generateMax (2^n)-  vBlinding <- fromInteger <$> Crypto.scalarGenerate curve-  let vCommit = commit v vBlinding-  pure ((v, vBlinding), vCommit)--test_verifyTPolynomial :: TestTree-test_verifyTPolynomial = localOption (QuickCheckTests 5) $-  testProperty "Verify T polynomial" $ QCM.monadicIO $ do-    n <- QCM.run $ (2 ^) <$> generateMax 8-    m <- QCM.run $ (2 ^) <$> generateMax 3-    ctx <- QCM.run $ replicateM m (setupV n)--    proofE <- QCM.run $ runExceptT $ MRP.generateProof (getUpperBound n) (fst <$> ctx)-    case proofE of-      Left err -> panic $ show err-      Right (proof@RP.RangeProof{..}) -> do-        let x, y, z :: Fq-            x = shamirX aCommit sCommit t1Commit t2Commit y z-            y = shamirY aCommit sCommit-            z = shamirZ aCommit sCommit y-        QCM.assert $ MRP.verifyTPoly n (snd <$> ctx) proof x y z--test_verifyLRCommitments :: TestTree-test_verifyLRCommitments = localOption (QuickCheckTests 5) $-  testProperty "Verify LR commitments" $ QCM.monadicIO $ do-    n <- QCM.run $ (2 ^) <$> generateMax 8-    m <- QCM.run $ (2 ^) <$> generateMax 3-    ctx <- QCM.run $ replicateM (fromIntegral m) (setupV n)--    proofE <- QCM.run $ runExceptT $ MRP.generateProof (getUpperBound n) (fst <$> ctx)-    case proofE of-      Left err -> panic $ show err-      Right (proof@RP.RangeProof{..}) -> do-        let x, y, z :: Fq-            x = shamirX aCommit sCommit t1Commit t2Commit y z-            y = shamirY aCommit sCommit-            z = shamirZ aCommit sCommit y--        QCM.assert $ MRP.verifyLRCommitment n m proof x y z--prop_valueNotInRange :: Property-prop_valueNotInRange = QCM.monadicIO $ do-  n <- QCM.run $ (2 ^) <$> generateMax 8-  ((v, vBlinding), vCommit) <- QCM.run $ setupV n-  let upperBound = getUpperBound n-      vNotInRange = fromInteger (toInt v + upperBound)--  proofE <- QCM.run $ runExceptT $ MRP.generateProof upperBound [(vNotInRange, vBlinding)]-  case proofE of-    Left err ->-      QCM.assert $ RP.ValuesNotInRange [vNotInRange] == err-    Right (proof@RP.RangeProof{..}) ->-      QCM.assert $ MRP.verifyProof upperBound [vCommit] proof--prop_invalidUpperBound :: Property-prop_invalidUpperBound = QCM.monadicIO $ do-  n <- QCM.run $ (2 ^) <$> generateMax 8-  ((v, vBlinding), vCommit) <- QCM.run $ setupV n-  let invalidUpperBound = _q + 1-  proofE <- QCM.run $ runExceptT $ MRP.generateProof invalidUpperBound [(v, vBlinding)]-  case proofE of-    Left err ->-      QCM.assert $ RP.UpperBoundTooLarge invalidUpperBound == err-    Right (proof@RP.RangeProof{..}) ->-      QCM.assert $ MRP.verifyProof invalidUpperBound [vCommit] proof--prop_differentUpperBound :: Positive Integer -> Property-prop_differentUpperBound (Positive upperBound') = expectFailure . QCM.monadicIO $ do-  n <- QCM.run $ (2 ^) <$> generateMax 8-  ((v, vBlinding), vCommit) <- QCM.run $ setupV n-  proofE <- QCM.run $ runExceptT $ MRP.generateProof @(PF Fq) (getUpperBound n) [(v, vBlinding)]-  case proofE of-    Left err -> panic $ show err-    Right (proof@RP.RangeProof{..}) ->-      QCM.assert $ MRP.verifyProof upperBound' [vCommit] proof--test_invalidCommitment :: TestTree-test_invalidCommitment = localOption (QuickCheckTests 20) $-  testProperty "Check invalid commitment" $ QCM.monadicIO $ do-  n <- QCM.run $ (2 ^) <$> generateMax 8-  ((v, vBlinding), vCommit) <- QCM.run $ setupV n-  let invalidVCommit = commit (v + 1) vBlinding-      upperBound = getUpperBound n-  proofE <- QCM.run $ runExceptT $ MRP.generateProof @(PF Fq) upperBound [(v, vBlinding)]-  case proofE of-    Left err -> panic $ show err-    Right (proof@(RP.RangeProof{..})) ->-      QCM.assert $ not $ MRP.verifyProof upperBound [invalidVCommit] proof--test_multiRangeProof_completeness :: TestTree-test_multiRangeProof_completeness = localOption (QuickCheckTests 5) $-  testProperty "Test multi range proof completeness" $ QCM.monadicIO $ do-    n <- QCM.run $ (2 ^) <$> generateMax 8-    m <- QCM.run $ generateBetween 1 10-    ctx <- QCM.run $ replicateM (fromIntegral m) (setupV n)-    let upperBound = getUpperBound n--    proofE <- QCM.run $ runExceptT $ MRP.generateProof @(PF Fq) (getUpperBound n) (fst <$> ctx)-    case proofE of-      Left err -> panic $ show err-      Right (proof@RP.RangeProof{..}) ->-        QCM.assert $ MRP.verifyProof upperBound (snd <$> ctx) proof--test_singleRangeProof_completeness :: TestTree-test_singleRangeProof_completeness = localOption (QuickCheckTests 20) $-  testProperty "Test single range proof completeness" $ QCM.monadicIO $ do-    n <- QCM.run $ (2 ^) <$> generateMax 8-    ((v, vBlinding), vCommit) <- QCM.run $ setupV n-    let upperBound = getUpperBound n--    proofE <- QCM.run $ runExceptT $ RP.generateProof @(PF Fq) (getUpperBound n) (v, vBlinding)-    case proofE of-      Left err -> panic $ show err-      Right (proof@RP.RangeProof{..}) ->-        QCM.assert $ RP.verifyProof upperBound vCommit proof--