module Pedersen (
Pedersen(..),
CommitParams(..),
Commitment(..),
Reveal(..),
setup,
commit,
open,
addCommitments,
verifyAddCommitments,
verifyCommitParams,
ECPedersen(..),
ECCommitParams(..),
ECCommitment(..),
ECReveal(..),
ecSetup,
ecCommit,
ecOpen,
ecAddCommitments,
ecVerifyAddCommitments,
ecAddInteger,
ecVerifyAddInteger,
verifyECCommitParams
) where
import Protolude
import qualified Prelude
import Crypto.Hash
import Crypto.Number.Serialize (os2ip)
import Crypto.Random.Types (MonadRandom(..))
import qualified Crypto.PubKey.ECC.Prim as ECC
import qualified Crypto.PubKey.ECC.Types as ECC
import Data.Bits (xor, popCount)
import qualified Data.ByteArray as BA
import qualified Data.Map as Map
import PrimeField
data CommitParams = CommitParams
{ pedersenSPF :: SPF
, pedersenH :: Integer
}
newtype Commitment = Commitment { unCommitment :: Integer }
deriving (Eq)
data Reveal = Reveal
{ revealVal :: Integer
, revealExp :: Integer
}
data Pedersen = Pedersen
{ commitment :: Commitment
, reveal :: Reveal
}
setup :: MonadRandom m => Int -> m (Integer, CommitParams)
setup nbits = do
spf <- mkSPF nbits
(a,h) <- runSPFT spf $ do
a <- randomInZqM
h <- gexpSafeSPFM a
return (a,h)
return (a, CommitParams spf h)
commit :: MonadRandom m => Integer -> CommitParams -> m Pedersen
commit x (CommitParams spf h) = do
(r,c) <- runSPFT spf $ do
r <- randomInZqM
c <- gexpSafeSPFM x |*| expSafeSPFM h r
return (r,c)
return $ Pedersen (Commitment c) (Reveal x r)
open :: CommitParams -> Commitment -> Reveal -> Bool
open (CommitParams spf h) (Commitment c) (Reveal x r) =
resCommit == c
where
resCommit = runSPFM spf $
gexpSafeSPFM x |*| expSafeSPFM h r
addCommitments :: CommitParams -> Commitment -> Commitment -> Commitment
addCommitments cp c1 c2 = Commitment $
modp (pedersenSPF cp) $ unCommitment c1 * unCommitment c2
verifyAddCommitments :: CommitParams -> Pedersen -> Pedersen -> Pedersen
verifyAddCommitments (CommitParams spf h) p1 p2 =
Pedersen newCommitment $ Reveal newVal newExp
where
(Reveal x r) = reveal p1
(Reveal y r') = reveal p2
newVal = modp spf $ x + y
newExp = modp spf $ r + r'
newCommitment = Commitment $ runSPFM spf $
gexpSafeSPFM newVal |*| expSafeSPFM h newExp
verifyCommitParams :: Integer -> CommitParams -> Bool
verifyCommitParams a (CommitParams spf h) =
runSPFM spf $ do
h' <- gexpSafeSPFM a
return $ h' == h
secp256k1 :: ECC.Curve
secp256k1 = ECC.getCurveByName ECC.SEC_p256k1
data ECCommitParams = ECCommitParams
{ ecCurve :: ECC.Curve
, ecH :: ECC.Point
}
data ECCommitment = ECCommitment { unECCommitment :: ECC.Point }
deriving Eq
data ECReveal = ECReveal
{ ecRevealVal :: Integer
, ecRevealScalar :: Integer
}
data ECPedersen = ECPedersen
{ ecCommitment :: ECCommitment
, ecReveal :: ECReveal
}
ecSetup :: MonadRandom m => Maybe ECC.CurveName -> m (ECC.PrivateNumber, ECCommitParams)
ecSetup mCurveName = do
a <- ECC.scalarGenerate curve
let h = ECC.pointBaseMul curve a
return (a, ECCommitParams curve h)
where
curve = case mCurveName of
Nothing -> secp256k1
Just cn' -> ECC.getCurveByName cn'
ecCommit :: MonadRandom m => Integer -> ECCommitParams -> m ECPedersen
ecCommit x (ECCommitParams curve h) = do
r <- ECC.scalarGenerate curve
let xG = ECC.pointBaseMul curve x
let rH = ECC.pointMul curve r h
let commitment = ECCommitment $ ECC.pointAdd curve xG rH
let reveal = ECReveal x r
return $ ECPedersen commitment reveal
ecOpen :: ECCommitParams -> ECCommitment -> ECReveal -> Bool
ecOpen (ECCommitParams curve h) (ECCommitment c) (ECReveal x r) =
c == ECC.pointAdd curve xG rH
where
xG = ECC.pointBaseMul curve x
rH = ECC.pointMul curve r h
ecAddCommitments
:: ECCommitParams
-> ECCommitment
-> ECCommitment
-> ECCommitment
ecAddCommitments ecp (ECCommitment c1) (ECCommitment c2) =
ECCommitment $ ECC.pointAdd (ecCurve ecp) c1 c2
ecVerifyAddCommitments
:: ECCommitParams
-> ECPedersen
-> ECPedersen
-> ECPedersen
ecVerifyAddCommitments (ECCommitParams curve h) p1 p2 =
ECPedersen newCommitment newReveal
where
ECReveal x1 r1 = ecReveal p1
ECReveal x2 r2 = ecReveal p2
newVal = x1 + x2
newScalar = r1 + r2
xG = ECC.pointBaseMul curve newVal
rH = ECC.pointMul curve newScalar h
newCommitment = ECCommitment $ ECC.pointAdd curve xG rH
newReveal = ECReveal newVal newScalar
ecAddInteger :: ECCommitParams -> ECCommitment -> Integer -> ECCommitment
ecAddInteger (ECCommitParams curve h) (ECCommitment c) n =
ECCommitment $ ECC.pointAdd curve nG c
where
nG = ECC.pointBaseMul curve n
ecVerifyAddInteger :: ECCommitParams -> ECPedersen -> Integer -> ECPedersen
ecVerifyAddInteger (ECCommitParams curve h) p n =
ECPedersen newCommitment newReveal
where
ECReveal x r = ecReveal p
newVal = x + n
xG = ECC.pointBaseMul curve newVal
rH = ECC.pointMul curve r h
newCommitment = ECCommitment $ ECC.pointAdd curve xG rH
newReveal = ECReveal newVal r
verifyECCommitParams :: Integer -> ECCommitParams -> Bool
verifyECCommitParams a (ECCommitParams curve h) = h == ECC.pointBaseMul curve a