{-# LANGUAGE DeriveGeneric, DeriveAnyClass, ViewPatterns #-}
module Bulletproofs.RangeProof.Internal where
import Protolude
import Numeric (showIntAtBase)
import Data.Char (intToDigit, digitToInt)
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.InnerProductProof.Internal
data RangeProof f p
= RangeProof
{ tBlinding :: f
, mu :: f
, t :: f
, aCommit :: p
, sCommit :: p
, t1Commit :: p
, t2Commit :: p
, productProof :: InnerProductProof f p
} deriving (Show, Eq, Generic, NFData)
data RangeProofError f
= UpperBoundTooLarge Integer
| ValueNotInRange f
| ValuesNotInRange [f]
| NNotPowerOf2 Integer
deriving (Show, Eq, Generic, NFData)
data LRPolys f
= LRPolys
{ l0 :: [f]
, l1 :: [f]
, r0 :: [f]
, r1 :: [f]
}
data TPoly f
= TPoly
{ t0 :: f
, t1 :: f
, t2 :: f
}
encodeBit :: Integer -> Fr -> [Fr]
encodeBit n v = fillWithZeros n $ fromIntegral . digitToInt <$> showIntAtBase 2 intToDigit (fromP v) ""
reversedEncodeBit :: Integer -> Fr -> [Fr]
reversedEncodeBit n = reverse . encodeBit n
reversedEncodeBitMulti :: Integer -> [Fr] -> [Fr]
reversedEncodeBitMulti n = foldl' (\acc v -> acc ++ reversedEncodeBit n v) []
complementaryVector :: Num a => [a] -> [a]
complementaryVector aL = (\vi -> vi - 1) <$> aL
fillWithZeros :: Num f => Integer -> [f] -> [f]
fillWithZeros n aL = zeros ++ aL
where
zeros = replicate (fromInteger n - length aL) 0
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 (hadamard aL aR) yN
where
yN = powerVector y n
obfuscateEncodedBitsSingle :: Integer -> [Fr] -> [Fr] -> Fr -> Fr -> Fr
obfuscateEncodedBitsSingle n aL aR y z
= dot
(aL ^-^ z1n)
(hadamard (powerVector y n) (aR ^+^ z1n) ^+^ ((*) (z ^ 2) <$> powerVector 2 n))
where
z1n = (*) z <$> powerVector 1 n
commitBitVectors
:: (MonadRandom m)
=> 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 = mul h aBlinding
sBlindingH = mul h sBlinding
let aCommit = aBlindingH <> aLG <> aRH
let sCommit = sBlindingH <> sLG <> sRH
pure (aCommit, sCommit)
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]
where
nm = n * m
checkRange :: Integer -> Fr -> Bool
checkRange n (fromP -> v) = v >= 0 && v < 2 ^ n
checkRanges :: Integer -> [Fr] -> Bool
checkRanges n vs = and $ fmap (\(fromP -> v) -> v >= 0 && v < 2 ^ n) vs
computeLRCommitment
:: Integer
-> Integer
-> PA
-> PA
-> Fr
-> Fr
-> Fr
-> Fr
-> Fr
-> Fr
-> [PA]
-> PA
computeLRCommitment n m aCommit sCommit t tBlinding mu x y z hs'
= aCommit
<>
(sCommit `mul` x)
<>
(inv (gsSum `mul` z))
<>
sumExps hExp hs'
<>
foldl'
(\acc j -> acc <> sumExps (hExp' j) (sliceHs' j))
mempty
[1..m]
<>
(inv (h `mul` mu))
<>
(u `mul` t)
where
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 = gen `mul` uChallenge
nm = n * m