{-# LANGUAGE DeriveGeneric, DeriveAnyClass, ViewPatterns #-}
module Bulletproofs.RangeProof.Internal where
import Protolude
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 Bulletproofs.Utils
import Bulletproofs.Curve
import Bulletproofs.InnerProductProof.Internal
data RangeProof f
= RangeProof
{ tBlinding :: f
, mu :: f
, t :: f
, aCommit :: Crypto.Point
, sCommit :: Crypto.Point
, t1Commit :: Crypto.Point
, t2Commit :: Crypto.Point
, productProof :: InnerProductProof f
} 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 :: KnownNat p => Integer -> PrimeField p -> [PrimeField p]
encodeBit n v = fillWithZeros n $ fromIntegral . digitToInt <$> showIntAtBase 2 intToDigit (toInt v) ""
reversedEncodeBit :: KnownNat p => Integer -> PrimeField p -> [PrimeField p]
reversedEncodeBit n = reverse . encodeBit n
reversedEncodeBitMulti :: KnownNat p => Integer -> [PrimeField p] -> [PrimeField p]
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 :: KnownNat p => Integer -> [PrimeField p] -> [PrimeField p] -> PrimeField p -> PrimeField p -> PrimeField p
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
where
yN = powerVector y n
obfuscateEncodedBitsSingle :: KnownNat p => Integer -> [PrimeField p] -> [PrimeField p] -> PrimeField p -> PrimeField p -> PrimeField p
obfuscateEncodedBitsSingle n aL aR y z
= dot
(aL ^-^ z1n)
(hadamardp (powerVector y n) (aR ^+^ z1n) ^+^ ((*) (z ^ 2) <$> powerVector 2 n))
where
z1n = (*) z <$> powerVector 1 n
commitBitVectors
:: (MonadRandom m)
=> PrimeField p
-> PrimeField p
-> [PrimeField p]
-> [PrimeField p]
-> [PrimeField p]
-> [PrimeField p]
-> m (Crypto.Point, Crypto.Point)
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
let aCommit = aBlindingH `addP` aLG `addP` aRH
let sCommit = sBlindingH `addP` sLG `addP` sRH
pure (aCommit, sCommit)
delta :: KnownNat p => Integer -> Integer -> PrimeField p -> PrimeField p -> PrimeField p
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 -> PrimeField p -> Bool
checkRange n (toInt -> v) = v >= 0 && v < 2 ^ n
checkRanges :: Integer -> [PrimeField p] -> Bool
checkRanges n vs = and $ fmap (\(toInt -> v) -> v >= 0 && v < 2 ^ n) vs
computeLRCommitment
:: KnownNat p
=> Integer
-> Integer
-> Crypto.Point
-> Crypto.Point
-> PrimeField p
-> PrimeField p
-> PrimeField p
-> PrimeField p
-> PrimeField p
-> PrimeField p
-> [Crypto.Point]
-> Crypto.Point
computeLRCommitment n m aCommit sCommit t tBlinding mu x y z hs'
= aCommit
`addP`
(x `mulP` sCommit)
`addP`
Crypto.pointNegate curve (z `mulP` gsSum)
`addP`
sumExps hExp hs'
`addP`
foldl'
(\acc j -> acc `addP` sumExps (hExp' j) (sliceHs' j))
Crypto.PointO
[1..m]
`addP`
Crypto.pointNegate curve (mu `mulP` h)
`addP`
(t `mulP` u)
where
gsSum = foldl' addP Crypto.PointO (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
nm = n * m