module Bulletproofs.RangeProof.Internal (
RangeProof(..),
RangeProofError(..),
LRPolys(..),
TPoly(..),
delta,
checkRange,
reversedEncodeBit,
complementaryVector,
chooseBlindingVectors,
commitBitVectors,
computeLRCommitment,
obfuscateEncodedBits,
obfuscateEncodedBitsSingle,
) where
import Protolude
import Numeric (showIntAtBase)
import Data.Char (intToDigit, digitToInt)
import Crypto.Random.Types (MonadRandom(..))
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 Bulletproofs.Utils
import Bulletproofs.Curve
import Bulletproofs.Fq as Fq
import Bulletproofs.InnerProductProof.Internal
data RangeProof
= RangeProof
{ tBlinding :: Fq
, mu :: Fq
, t :: Fq
, aCommit :: Crypto.Point
, sCommit :: Crypto.Point
, t1Commit :: Crypto.Point
, t2Commit :: Crypto.Point
, productProof :: InnerProductProof
} deriving (Show, Eq)
data RangeProofError
= UpperBoundTooLarge Integer
| ValueNotInRange Integer
| NNotPowerOf2 Integer
deriving (Show)
data LRPolys
= LRPolys
{ l0 :: [Fq]
, l1 :: [Fq]
, r0 :: [Fq]
, r1 :: [Fq]
}
data TPoly
= TPoly
{ t0 :: Fq
, t1 :: Fq
, t2 :: Fq
}
encodeBit :: Integer -> Fq -> [Fq]
encodeBit n (Fq v) = fillWithZeros n $ Fq.new . fromIntegral . digitToInt <$> showIntAtBase 2 intToDigit v ""
reversedEncodeBit :: Integer -> Fq -> [Fq]
reversedEncodeBit n = reverse . encodeBit n
complementaryVector :: Num a => [a] -> [a]
complementaryVector aL = (\vi -> vi - 1) <$> aL
fillWithZeros :: Integer -> [Fq] -> [Fq]
fillWithZeros n aL = zeros ++ aL
where
zeros = replicate (fromInteger n - length aL) (Fq 0)
obfuscateEncodedBits :: Integer -> [Fq] -> [Fq] -> Fq -> Fq -> Fq
obfuscateEncodedBits n aL aR y z
= (fqSquare z * dotp aL (powerVector 2 n))
+ (z * dotp ((aL `fqSubV` powerVector 1 n) `fqSubV` aR) yN)
+ dotp (hadamardp aL aR) yN
where
yN = powerVector y n
obfuscateEncodedBitsSingle :: Integer -> [Fq] -> [Fq] -> Fq -> Fq -> Fq
obfuscateEncodedBitsSingle n aL aR y z
= dotp
(aL `fqSubV` z1n)
(hadamardp (powerVector y n) (aR `fqAddV` z1n) `fqAddV` ((*) (fqSquare z) <$> powerVector 2 n))
where
z1n = (*) z <$> powerVector 1 n
commitBitVectors
:: MonadRandom m
=> Fq
-> Fq
-> [Fq]
-> [Fq]
-> [Fq]
-> [Fq]
-> m (Crypto.Point, Crypto.Point)
commitBitVectors aBlinding sBlinding aL aR sL sR = do
let aLG = foldl' addP Crypto.PointO ( zipWith mulP aL gs )
aRH = foldl' addP Crypto.PointO ( zipWith mulP aR hs )
sLG = foldl' addP Crypto.PointO ( zipWith mulP sL gs )
sRH = foldl' addP Crypto.PointO ( zipWith mulP sR hs )
aBlindingH = mulP aBlinding h
sBlindingH = mulP sBlinding h
let aCommit = aBlindingH `addP` aLG `addP` aRH
let sCommit = sBlindingH `addP` sLG `addP` sRH
pure (aCommit, sCommit)
chooseBlindingVectors :: MonadRandom m => Integer -> m ([Fq], [Fq])
chooseBlindingVectors n = do
sL <- replicateM (fromInteger n) (Fq.random n)
sR <- replicateM (fromInteger n) (Fq.random n)
pure (sL, sR)
delta :: Integer -> Fq -> Fq -> Fq
delta n y z
= ((z - Fq.fqSquare z) * dotp (powerVector 1 n) (powerVector y n))
- (Fq.fqCube z * dotp (powerVector 1 n) (powerVector 2 n))
checkRange :: Integer -> Integer -> Bool
checkRange n v = v >= 0 && v < 2 ^ n
computeLRCommitment
:: Integer
-> Crypto.Point
-> Crypto.Point
-> Fq
-> Fq
-> Fq
-> Fq
-> Fq
-> Fq
-> [Crypto.Point]
-> Crypto.Point
computeLRCommitment n aCommit sCommit t tBlinding mu x y z hs'
= aCommit
`addP`
(x `mulP` sCommit)
`addP`
Crypto.pointNegate curve (z `mulP` gsSum)
`addP`
foldl' addP Crypto.PointO (zipWith mulP hExp hs')
`addP`
Crypto.pointNegate curve (mu `mulP` h)
`addP`
(t `mulP` u)
where
gsSum = foldl' addP Crypto.PointO (take (fromIntegral n) gs)
hExp = ((*) z <$> powerVector y n) `fqAddV` ((*) (fqSquare z) <$> powerVector 2 n)
uChallenge = shamirU tBlinding mu t
u = uChallenge `mulP` g