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 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)
data RangeProofError
= UpperBoundTooLarge Integer
| ValueNotInRange Integer
| ValuesNotInRange [Integer]
| NNotPowerOf2 Integer
deriving (Show, Eq)
data LRPolys f
= LRPolys
{ l0 :: [f]
, l1 :: [f]
, r0 :: [f]
, r1 :: [f]
}
data TPoly f
= TPoly
{ t0 :: f
, t1 :: f
, t2 :: f
}
encodeBit :: (AsInteger f, Num f) => Integer -> f -> [f]
encodeBit n v = fillWithZeros n $ fromIntegral . digitToInt <$> showIntAtBase 2 intToDigit (asInteger v) ""
reversedEncodeBit :: (AsInteger f, Num f) => Integer -> f -> [f]
reversedEncodeBit n = reverse . encodeBit n
reversedEncodeBitMulti :: (AsInteger f, Num f) => Integer -> [f] -> [f]
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 :: (Eq f, Field f) => Integer -> [f] -> [f] -> f -> f -> f
obfuscateEncodedBits n aL aR y z
= (fSquare z * dot aL (powerVector 2 n))
+ (z * dot ((aL ^-^ powerVector 1 n) ^-^ aR) yN)
+ dot (hadamardp aL aR) yN
where
yN = powerVector y n
obfuscateEncodedBitsSingle :: (Eq f, Field f) => Integer -> [f] -> [f] -> f -> f -> f
obfuscateEncodedBitsSingle n aL aR y z
= dot
(aL ^-^ z1n)
(hadamardp (powerVector y n) (aR ^+^ z1n) ^+^ ((*) (fSquare z) <$> powerVector 2 n))
where
z1n = (*) z <$> powerVector 1 n
commitBitVectors
:: (MonadRandom m, AsInteger f)
=> f
-> f
-> [f]
-> [f]
-> [f]
-> [f]
-> m (Crypto.Point, Crypto.Point)
commitBitVectors aBlinding sBlinding aL aR sL sR = do
let aLG = foldl' addP Crypto.PointO ( zipWith mulP aL gs )
aRH = foldl' addP Crypto.PointO ( zipWith mulP aR hs )
sLG = foldl' addP Crypto.PointO ( zipWith mulP sL gs )
sRH = foldl' addP Crypto.PointO ( zipWith mulP sR hs )
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 :: (Eq f, Field f) => Integer -> Integer -> f -> f -> f
delta n m y z
= ((z - fSquare z) * 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 -> Integer -> Bool
checkRange n v = v >= 0 && v < 2 ^ n
checkRanges :: Integer -> [Integer] -> Bool
checkRanges n vs = and $ fmap (\v -> v >= 0 && v < 2 ^ n) vs
computeLRCommitment
:: (AsInteger f, Eq f, Num f, Show f)
=> Integer
-> Integer
-> Crypto.Point
-> Crypto.Point
-> f
-> f
-> f
-> f
-> f
-> f
-> [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`
foldl' addP Crypto.PointO (zipWith mulP hExp hs')
`addP`
foldl'
(\acc j -> acc `addP` foldl' addP Crypto.PointO (zipWith mulP (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