Initial release.

.gitignore

@@ -0,0 +1,3 @@
+.stack-work/
+bulletproofs.cabal
+*~

Bulletproofs/Curve.hs

@@ -0,0 +1,79 @@
+module Bulletproofs.Curve where
+
+import Protolude hiding (hash)
+
+import Crypto.Hash
+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 qualified Data.ByteArray as BA
+import Crypto.Number.Serialize (os2ip)
+import Math.NumberTheory.Moduli.Sqrt (sqrtModP)
+
+-- TEST
+import Numeric
+import qualified Data.List as L
+
+curveName :: Crypto.CurveName
+curveName = Crypto.SEC_p256k1
+
+curve :: Crypto.Curve
+curve = Crypto.getCurveByName curveName
+
+-- | Order of the curve
+q :: Integer
+q = Crypto.ecc_n . Crypto.common_curve $ curve
+
+-- | Generator of the curve
+g :: Crypto.Point
+g = Crypto.ecc_g $ Crypto.common_curve curve
+
+-- | H = aG where a is not known
+h :: Crypto.Point
+h = generateH g ""
+
+-- | Generate vector of generators in a deterministic way from the curve generator g
+-- by applying H(encode(g) || i) where H is a secure hash function
+gs :: [Crypto.Point]
+gs = Crypto.pointBaseMul curve . oracle . (<> pointToBS g) . show <$> [1..]
+
+-- | Generate vector of generators in a deterministic way from the curve generator h
+-- by applying H(encode(h) || i) where H is a secure hash function
+hs :: [Crypto.Point]
+hs = Crypto.pointBaseMul curve . oracle . (<> pointToBS h) . show <$> [1..]
+
+-- | A random oracle. In the Fiat-Shamir heuristic, its input
+-- is specifically the transcript of the interaction up to that point.
+oracle :: ByteString -> Integer
+oracle x = os2ip (sha256 x)
+
+sha256 :: ByteString -> ByteString
+sha256 bs = BA.convert (hash bs :: Digest SHA3_256)
+
+pointToBS :: Crypto.Point -> ByteString
+pointToBS Crypto.PointO      = ""
+pointToBS (Crypto.Point x y) = show x <> show y
+
+-- | Characteristic of the underlying finite field of the elliptic curve
+p :: Integer
+p = Crypto.ecc_p cp
+  where
+    cp = case curve of
+      Crypto.CurveFP c -> c
+      Crypto.CurveF2m _ -> panic "Not a FP curve"
+
+-- | Iterative algorithm to generate H.
+-- The important thing about the H value is that nobody gets
+-- to know its discrete logarithm "k" such that H = kG
+generateH :: Crypto.Point -> [Char] -> Crypto.Point
+generateH basePoint extra =
+  case yM of
+    Nothing -> generateH basePoint (toS $ '1':extra)
+    Just y -> if Crypto.isPointValid curve (Crypto.Point x y)
+      then Crypto.Point x y
+      else generateH basePoint (toS $ '1':extra)
+  where
+    x = oracle (pointToBS basePoint <> toS extra) `mod` p
+    yM = sqrtModP (x ^ 3 + 7) p
+

Bulletproofs/Fq.hs

@@ -0,0 +1,110 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Bulletproofs.Fq where
+
+import Protolude
+
+import Crypto.Random (MonadRandom)
+import Crypto.Number.Generate (generateMax)
+
+import Bulletproofs.Curve
+
+-------------------------------------------------------------------------------
+-- Types
+-------------------------------------------------------------------------------
+
+-- | Prime field with characteristic @_q@
+newtype Fq = Fq Integer -- ^ Use @new@ instead of this constructor
+  deriving (Show, Eq, Bits, Ord)
+
+instance Num Fq where
+  (+)           = fqAdd
+  (*)           = fqMul
+  abs           = panic "There is no absolute value in a finite field"
+  signum        = panic "This function doesn't make sense in a finite field"
+  negate        = fqNeg
+  fromInteger   = new
+
+instance Fractional Fq where
+  (/) = fqDiv
+  fromRational (a :% b) = Fq a / Fq b
+
+-- | Turn an integer into an @Fq@ number, should be used instead of
+-- the @Fq@ constructor.
+new :: Integer -> Fq
+new a = Fq (a `mod` q)
+
+{-# INLINE norm #-}
+norm :: Fq -> Fq
+norm (Fq a) = Fq (a `mod` q)
+
+{-# INLINE fqAdd #-}
+fqAdd :: Fq -> Fq -> Fq
+fqAdd (Fq a) (Fq b) = norm (Fq (a+b))
+
+{-# INLINE fqMul #-}
+fqMul :: Fq -> Fq -> Fq
+fqMul (Fq a) (Fq b) = norm (Fq (a*b))
+
+{-# INLINE fqNeg #-}
+fqNeg :: Fq -> Fq
+fqNeg (Fq a) = Fq ((-a) `mod` q)
+
+{-# INLINE fqDiv #-}
+fqDiv :: Fq -> Fq -> Fq
+fqDiv a b = fqMul a (inv b)
+
+{-# INLINE fqInv #-}
+-- | Multiplicative inverse
+fqInv :: Fq -> Fq
+fqInv x = 1 / x
+
+{-# INLINE fqZero #-}
+-- | Additive identity
+fqZero :: Fq
+fqZero = Fq 0
+
+{-# INLINE fqOne #-}
+-- | Multiplicative identity
+fqOne :: Fq
+fqOne = Fq 1
+
+fqSquare :: Fq -> Fq
+fqSquare x = fqMul x x
+
+fqCube :: Fq -> Fq
+fqCube x = fqMul x (fqMul x x)
+
+inv :: Fq -> Fq
+inv (Fq a) = Fq $ euclidean a q `mod` q
+
+asInteger :: Fq -> Integer
+asInteger (Fq n) = n
+
+-- | Euclidean algorithm to compute inverse in an integral domain @a@
+euclidean :: (Integral a) => a -> a -> a
+euclidean a b = fst (inv' a b)
+
+{-# INLINEABLE inv' #-}
+{-# SPECIALISE inv' :: Integer -> Integer -> (Integer, Integer) #-}
+inv' :: (Integral a) => a -> a -> (a, a)
+inv' a b =
+  case b of
+   1 -> (0, 1)
+   _ -> let (e, f) = inv' b d
+        in (f, e - c*f)
+  where c = a `div` b
+        d = a `mod` b
+
+random :: MonadRandom m => Integer -> m Fq
+random n = Fq <$> generateMax (2^n)
+
+fqAddV :: [Fq] -> [Fq] -> [Fq]
+fqAddV = zipWith (+)
+
+fqSubV :: [Fq] -> [Fq] -> [Fq]
+fqSubV = zipWith (-)
+
+fqMulV :: [Fq] -> [Fq] -> [Fq]
+fqMulV = zipWith (*)
+

Bulletproofs/InnerProductProof.hs

@@ -0,0 +1,13 @@
+module Bulletproofs.InnerProductProof
+( generateProof
+, verifyProof
+
+, InnerProductProof(..)
+, InnerProductBase(..)
+, InnerProductWitness(..)
+) where
+
+
+import Bulletproofs.InnerProductProof.Internal
+import Bulletproofs.InnerProductProof.Prover
+import Bulletproofs.InnerProductProof.Verifier

Bulletproofs/InnerProductProof/Internal.hs

@@ -0,0 +1,42 @@
+module Bulletproofs.InnerProductProof.Internal where
+
+import Protolude
+
+import qualified Crypto.PubKey.ECC.Types as Crypto
+import Bulletproofs.Fq
+
+data InnerProductProof
+  = InnerProductProof
+    { lCommits :: [Crypto.Point]
+    -- ^ Vector of commitments of the elements in the original vector l
+    -- whose size is the logarithm of base 2 of the size of vector l
+    , rCommits :: [Crypto.Point]
+    -- ^ Vector of commitments of the elements in the original vector r
+    -- whose size is the logarithm of base 2 of the size of vector r
+    , l :: Fq
+    -- ^ Remaining element of vector l at the end of
+    -- the recursive algorithm that generates the inner-product proof
+    , r :: Fq
+    -- ^ Remaining element of vector r at the end of
+    -- the recursive algorithm that generates the inner-product proof
+    } deriving (Show, Eq)
+
+data InnerProductWitness
+  = InnerProductWitness
+    { ls :: [Fq]
+    -- ^ Vector of values l that the prover uses to compute lCommits
+    -- in the recursive inner product algorithm
+    , rs :: [Fq]
+    -- ^ Vector of values r that the prover uses to compute rCommits
+    -- in the recursive inner product algorithm
+    } deriving (Show, Eq)
+
+data InnerProductBase
+  = InnerProductBase
+    { bGs :: [Crypto.Point]  -- ^ Independent generator Gs ∈ G^n
+    , bHs :: [Crypto.Point]  -- ^ Independent generator Hs ∈ G^n
+    , bH :: Crypto.Point
+    -- ^ Internally fixed group element H ∈  G
+    -- for which there is no known discrete-log relation among Gs, Hs, bG
+    } deriving (Show, Eq)
+