Skip to content

Commit e0e7349

Browse files
sdiehlsdiehl
committed
Initial release.
0 parents  commit e0e7349

23 files changed

+1665
-0
lines changed

‎.gitignore

+3
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
.stack-work/
2+
bulletproofs.cabal
3+
*~

‎Bulletproofs/Curve.hs

+79
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,79 @@
1+
module Bulletproofs.Curve where
2+
3+
import Protolude hiding (hash)
4+
5+
import Crypto.Hash
6+
import qualified Crypto.PubKey.ECC.Generate as Crypto
7+
import qualified Crypto.PubKey.ECC.Prim as Crypto
8+
import qualified Crypto.PubKey.ECC.Types as Crypto
9+
10+
import qualified Data.ByteArray as BA
11+
import Crypto.Number.Serialize (os2ip)
12+
import Math.NumberTheory.Moduli.Sqrt (sqrtModP)
13+
14+
-- TEST
15+
import Numeric
16+
import qualified Data.List as L
17+
18+
curveName :: Crypto.CurveName
19+
curveName = Crypto.SEC_p256k1
20+
21+
curve :: Crypto.Curve
22+
curve = Crypto.getCurveByName curveName
23+
24+
-- | Order of the curve
25+
q :: Integer
26+
q = Crypto.ecc_n . Crypto.common_curve $ curve
27+
28+
-- | Generator of the curve
29+
g :: Crypto.Point
30+
g = Crypto.ecc_g $ Crypto.common_curve curve
31+
32+
-- | H = aG where a is not known
33+
h :: Crypto.Point
34+
h = generateH g ""
35+
36+
-- | Generate vector of generators in a deterministic way from the curve generator g
37+
-- by applying H(encode(g) || i) where H is a secure hash function
38+
gs :: [Crypto.Point]
39+
gs = Crypto.pointBaseMul curve . oracle . (<> pointToBS g) . show <$> [1..]
40+
41+
-- | Generate vector of generators in a deterministic way from the curve generator h
42+
-- by applying H(encode(h) || i) where H is a secure hash function
43+
hs :: [Crypto.Point]
44+
hs = Crypto.pointBaseMul curve . oracle . (<> pointToBS h) . show <$> [1..]
45+
46+
-- | A random oracle. In the Fiat-Shamir heuristic, its input
47+
-- is specifically the transcript of the interaction up to that point.
48+
oracle :: ByteString -> Integer
49+
oracle x = os2ip (sha256 x)
50+
51+
sha256 :: ByteString -> ByteString
52+
sha256 bs = BA.convert (hash bs :: Digest SHA3_256)
53+
54+
pointToBS :: Crypto.Point -> ByteString
55+
pointToBS Crypto.PointO = ""
56+
pointToBS (Crypto.Point x y) = show x <> show y
57+
58+
-- | Characteristic of the underlying finite field of the elliptic curve
59+
p :: Integer
60+
p = Crypto.ecc_p cp
61+
where
62+
cp = case curve of
63+
Crypto.CurveFP c -> c
64+
Crypto.CurveF2m _ -> panic "Not a FP curve"
65+
66+
-- | Iterative algorithm to generate H.
67+
-- The important thing about the H value is that nobody gets
68+
-- to know its discrete logarithm "k" such that H = kG
69+
generateH :: Crypto.Point -> [Char] -> Crypto.Point
70+
generateH basePoint extra =
71+
case yM of
72+
Nothing -> generateH basePoint (toS $ '1':extra)
73+
Just y -> if Crypto.isPointValid curve (Crypto.Point x y)
74+
then Crypto.Point x y
75+
else generateH basePoint (toS $ '1':extra)
76+
where
77+
x = oracle (pointToBS basePoint <> toS extra) `mod` p
78+
yM = sqrtModP (x ^ 3 + 7) p
79+

‎Bulletproofs/Fq.hs

+110
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,110 @@
1+
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+
3+
module Bulletproofs.Fq where
4+
5+
import Protolude
6+
7+
import Crypto.Random (MonadRandom)
8+
import Crypto.Number.Generate (generateMax)
9+
10+
import Bulletproofs.Curve
11+
12+
-------------------------------------------------------------------------------
13+
-- Types
14+
-------------------------------------------------------------------------------
15+
16+
-- | Prime field with characteristic @_q@
17+
newtype Fq = Fq Integer -- ^ Use @new@ instead of this constructor
18+
deriving (Show, Eq, Bits, Ord)
19+
20+
instance Num Fq where
21+
(+) = fqAdd
22+
(*) = fqMul
23+
abs = panic "There is no absolute value in a finite field"
24+
signum = panic "This function doesn't make sense in a finite field"
25+
negate = fqNeg
26+
fromInteger = new
27+
28+
instance Fractional Fq where
29+
(/) = fqDiv
30+
fromRational (a :% b) = Fq a / Fq b
31+
32+
-- | Turn an integer into an @Fq@ number, should be used instead of
33+
-- the @Fq@ constructor.
34+
new :: Integer -> Fq
35+
new a = Fq (a `mod` q)
36+
37+
{-# INLINE norm #-}
38+
norm :: Fq -> Fq
39+
norm (Fq a) = Fq (a `mod` q)
40+
41+
{-# INLINE fqAdd #-}
42+
fqAdd :: Fq -> Fq -> Fq
43+
fqAdd (Fq a) (Fq b) = norm (Fq (a+b))
44+
45+
{-# INLINE fqMul #-}
46+
fqMul :: Fq -> Fq -> Fq
47+
fqMul (Fq a) (Fq b) = norm (Fq (a*b))
48+
49+
{-# INLINE fqNeg #-}
50+
fqNeg :: Fq -> Fq
51+
fqNeg (Fq a) = Fq ((-a) `mod` q)
52+
53+
{-# INLINE fqDiv #-}
54+
fqDiv :: Fq -> Fq -> Fq
55+
fqDiv a b = fqMul a (inv b)
56+
57+
{-# INLINE fqInv #-}
58+
-- | Multiplicative inverse
59+
fqInv :: Fq -> Fq
60+
fqInv x = 1 / x
61+
62+
{-# INLINE fqZero #-}
63+
-- | Additive identity
64+
fqZero :: Fq
65+
fqZero = Fq 0
66+
67+
{-# INLINE fqOne #-}
68+
-- | Multiplicative identity
69+
fqOne :: Fq
70+
fqOne = Fq 1
71+
72+
fqSquare :: Fq -> Fq
73+
fqSquare x = fqMul x x
74+
75+
fqCube :: Fq -> Fq
76+
fqCube x = fqMul x (fqMul x x)
77+
78+
inv :: Fq -> Fq
79+
inv (Fq a) = Fq $ euclidean a q `mod` q
80+
81+
asInteger :: Fq -> Integer
82+
asInteger (Fq n) = n
83+
84+
-- | Euclidean algorithm to compute inverse in an integral domain @a@
85+
euclidean :: (Integral a) => a -> a -> a
86+
euclidean a b = fst (inv' a b)
87+
88+
{-# INLINEABLE inv' #-}
89+
{-# SPECIALISE inv' :: Integer -> Integer -> (Integer, Integer) #-}
90+
inv' :: (Integral a) => a -> a -> (a, a)
91+
inv' a b =
92+
case b of
93+
1 -> (0, 1)
94+
_ -> let (e, f) = inv' b d
95+
in (f, e - c*f)
96+
where c = a `div` b
97+
d = a `mod` b
98+
99+
random :: MonadRandom m => Integer -> m Fq
100+
random n = Fq <$> generateMax (2^n)
101+
102+
fqAddV :: [Fq] -> [Fq] -> [Fq]
103+
fqAddV = zipWith (+)
104+
105+
fqSubV :: [Fq] -> [Fq] -> [Fq]
106+
fqSubV = zipWith (-)
107+
108+
fqMulV :: [Fq] -> [Fq] -> [Fq]
109+
fqMulV = zipWith (*)
110+

‎Bulletproofs/InnerProductProof.hs

+13
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,13 @@
1+
module Bulletproofs.InnerProductProof
2+
( generateProof
3+
, verifyProof
4+
5+
, InnerProductProof(..)
6+
, InnerProductBase(..)
7+
, InnerProductWitness(..)
8+
) where
9+
10+
11+
import Bulletproofs.InnerProductProof.Internal
12+
import Bulletproofs.InnerProductProof.Prover
13+
import Bulletproofs.InnerProductProof.Verifier

‎Bulletproofs/InnerProductProof/Internal.hs

+42
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,42 @@
1+
module Bulletproofs.InnerProductProof.Internal where
2+
3+
import Protolude
4+
5+
import qualified Crypto.PubKey.ECC.Types as Crypto
6+
import Bulletproofs.Fq
7+
8+
data InnerProductProof
9+
= InnerProductProof
10+
{ lCommits :: [Crypto.Point]
11+
-- ^ Vector of commitments of the elements in the original vector l
12+
-- whose size is the logarithm of base 2 of the size of vector l
13+
, rCommits :: [Crypto.Point]
14+
-- ^ Vector of commitments of the elements in the original vector r
15+
-- whose size is the logarithm of base 2 of the size of vector r
16+
, l :: Fq
17+
-- ^ Remaining element of vector l at the end of
18+
-- the recursive algorithm that generates the inner-product proof
19+
, r :: Fq
20+
-- ^ Remaining element of vector r at the end of
21+
-- the recursive algorithm that generates the inner-product proof
22+
} deriving (Show, Eq)
23+
24+
data InnerProductWitness
25+
= InnerProductWitness
26+
{ ls :: [Fq]
27+
-- ^ Vector of values l that the prover uses to compute lCommits
28+
-- in the recursive inner product algorithm
29+
, rs :: [Fq]
30+
-- ^ Vector of values r that the prover uses to compute rCommits
31+
-- in the recursive inner product algorithm
32+
} deriving (Show, Eq)
33+
34+
data InnerProductBase
35+
= InnerProductBase
36+
{ bGs :: [Crypto.Point] -- ^ Independent generator Gs ∈ G^n
37+
, bHs :: [Crypto.Point] -- ^ Independent generator Hs ∈ G^n
38+
, bH :: Crypto.Point
39+
-- ^ Internally fixed group element H ∈ G
40+
-- for which there is no known discrete-log relation among Gs, Hs, bG
41+
} deriving (Show, Eq)
42+

0 commit comments

Comments
 (0)