module Protocol.Election where
import Control.Applicative (Applicative(..))
-import Control.Monad (Monad(..), join, mapM, unless, zipWithM)
+import Control.Monad (Monad(..), join, mapM, replicateM, unless, zipWithM)
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Trans.Except (ExceptT, runExcept, throwE, withExceptT)
import Data.Bool
import Data.Semigroup (Semigroup(..))
import Data.Text (Text)
import Data.Traversable (Traversable(..))
-import Data.Tuple (fst, snd, uncurry, curry)
+import Data.Tuple (fst, snd, uncurry)
import GHC.Natural (minusNaturalMaybe)
import Numeric.Natural (Natural)
import Prelude (fromIntegral)
-- ^ Public part of the randomness 'encNonce' used to 'encrypt' the 'clear' text,
-- equal to @('groupGen' '^'encNonce)@
, encryption_vault :: G q
- -- ^ Encrypted 'clear' text, equal to @('pubKey' '^'r '*' 'groupGen' '^'clear)@
+ -- ^ Encrypted 'clear' text,
+ -- equal to @('pubKey' '^'encNone '*' 'groupGen' '^'clear)@
} deriving (Eq,Show)
-- | Additive homomorphism.
-- ^ A discrete logarithm sent by the prover to the verifier,
-- as a response to 'proof_challenge'.
--
- -- If the verifier observes that @('proof_challenge' '==' 'hash' statement [commitment])@
- -- where:
+ -- If the verifier observes that @('proof_challenge' '==' 'hash' statement [commitment])@, where:
--
- -- * @statement@ is a serialization of a tag, 'base' and 'basePowSec',
- -- * @(commitment '==' 'commit' proof base basePowSec '=='
- -- base '^' 'proof_response' '*' basePowSec '^' 'proof_challenge')@,
- -- * and @(basePowSec '==' base'^'sec)@,
+ -- * @statement@ is a serialization of a tag, @base@ and @basePowSec@,
+ -- * @commitment '==' 'commit' proof base basePowSec '=='
+ -- base '^' 'proof_response' '*' basePowSec '^' 'proof_challenge'@,
+ -- * and @basePowSec '==' base'^'sec@,
--
- -- then, with overwhelming probability due to the 'hash' function:
- -- @(commitment '==' base'^'nonce)@.
- -- Therefore by expanding 'commitment':
- -- @('proof_response' '==' logBase base (base'^'nonce) '-' logBase basePowSec (basePowSec '^' 'proof_challenge'))@,
- -- which means that the prover must have known 'nonce' and 'sec'
- -- to compute 'proof_response' efficiently with:
- -- @('proof_response' '==' nonce '-' sec '*' 'proof_challenge')@,
+ -- then, with overwhelming probability (due to the 'hash' function),
+ -- the prover was not able to choose 'proof_challenge'
+ -- yet was able to compute a 'proof_response' such that
+ -- (@commitment '==' base '^' 'proof_response' '*' basePowSec '^' 'proof_challenge'@),
+ -- that is to say: @('proof_response' '==' logBase base 'commitment' '-' sec '*' 'proof_challenge')@,
+ -- therefore the prover knows 'sec'.
--
- -- The 'nonce' is introduced to ensure each 'prove' does not reveal
- -- any information regarding the prover's secret 'sec',
- -- by being randomly chosen by the prover.
+ -- The prover choses 'commitment' to be a random power of @base@,
+ -- to ensure that each 'prove' does not reveal any information about its secret.
} deriving (Eq,Show)
-- ** Type 'ZKP'
--- | Zero-knowledge proof
+-- | Zero-knowledge proof.
+--
+-- A protocol is /zero-knowledge/ if the verifier
+-- learns nothing from the protocol except that the prover
+-- knows the secret.
--
-- DOC: Mihir Bellare and Phillip Rogaway. Random oracles are practical:
-- A paradigm for designing efficient protocols. In ACM-CCS’93, 1993.
---
--- DOC: Pierrick Gaudry. <https://hal.inria.fr/hal-01576379 Some ZK security proofs for Belenios>, 2017.
newtype ZKP = ZKP BS.ByteString
-- ** Type 'Challenge'
type Oracle list q = list (Commitment q) -> Challenge q
-- | @('prove' sec commitBases oracle)@
--- returns a 'Proof' that @sec@ is known.
+-- returns a 'Proof' that @sec@ is known
+-- (by proving the knowledge of its discrete logarithm).
--
--- The 'Oracle' is given the 'commitBases'
+-- The 'Oracle' is given 'Commitment's equal to the 'commitBases'
-- raised to the power of the secret nonce of the 'Proof',
--- as those are the 'commitBases' that the verifier will obtain
+-- as those are the 'Commitment's that the verifier will obtain
-- when composing the 'proof_challenge' and 'proof_response' together
--- (in 'commit').
+-- (with 'commit').
--
--- NOTE: 'sec' is @secKey@ in 'signature_proof' or @encNonce@ in 'proveEncryption'.
+-- NOTE: @sec@ is @secKey@ in 'signature_proof' or @encNonce@ in 'proveEncryption'.
--
-- WARNING: for 'prove' to be a so-called /strong Fiat-Shamir transformation/ (not a weak):
-- the statement must be included in the 'hash' (not only the commitments).
--
-- NOTE: a 'random' @nonce@ is used to ensure each 'prove'
--- does not reveal any information regarding the secret 'sec'.
+-- does not reveal any information regarding the secret @sec@,
+-- because two 'Proof's using the same 'Commitment'
+-- can be used to deduce @sec@ (using the special-soundness).
prove ::
Monad m => RandomGen r => SubGroup q => Functor list =>
- E q -> list (Commitment q) -> Oracle list q -> S.StateT r m (Proof q)
+ E q -> list (G q) -> Oracle list q -> S.StateT r m (Proof q)
prove sec commitBases oracle = do
nonce <- random
- let proof_challenge = oracle $ (^ nonce) <$> commitBases
+ let commitments = (^ nonce) <$> commitBases
+ let proof_challenge = oracle commitments
return Proof
{ proof_challenge
, proof_response = nonce - sec*proof_challenge
}
+-- | @('fakeProof')@ returns a 'Proof'
+-- whose 'proof_challenge' and 'proof_response' are uniformly chosen at random,
+-- instead of @('proof_challenge' '==' 'hash' statement commitments)@
+-- and @('proof_response' '==' nonce '+' sec '*' 'proof_challenge')@
+-- as a 'Proof' returned by 'prove'.
+--
+-- Used in 'proveEncryption' to fill the returned 'DisjProof'
+-- with fake 'Proof's for all 'Disjunction's but the encrypted one.
+fakeProof :: Monad m => RandomGen r => SubGroup q => S.StateT r m (Proof q)
+fakeProof = do
+ proof_challenge <- random
+ proof_response <- random
+ return Proof{..}
+
-- ** Type 'Commitment'
+-- | A commitment from the prover to the verifier.
+-- It's a power of 'groupGen' chosen randomly by the prover
+-- when making a 'Proof' with 'prove'.
type Commitment = G
-- | @('commit' proof base basePowSec)@ returns a 'Commitment'
-- | @('proveEncryption' elecPubKey voterZKP (prevDisjs,nextDisjs) (encNonce,enc))@
-- returns a 'DisjProof' that 'enc' 'encrypt's
--- the 'Disjunction's between 'prevDisjs' and 'nextDisjs'.
+-- the 'Disjunction' 'd' between 'prevDisjs' and 'nextDisjs'.
+--
+-- The prover proves that it knows an 'encNonce', such that:
+-- @(enc '==' Encryption{encryption_nonce='groupGen' '^'encNonce, encryption_vault=elecPubKey'^'encNonce '*' groupGen'^'d})@
--
-- A /NIZK Disjunctive Chaum Pedersen Logarithm Equality/ is used.
+--
+-- DOC: Pierrick Gaudry. <https://hal.inria.fr/hal-01576379 Some ZK security proofs for Belenios>, 2017.
proveEncryption ::
- forall m r q.
Monad m => RandomGen r => SubGroup q =>
PublicKey q -> ZKP ->
([Disjunction q],[Disjunction q]) ->
(EncryptionNonce q, Encryption q) ->
S.StateT r m (DisjProof q)
proveEncryption elecPubKey voterZKP (prevDisjs,nextDisjs) (encNonce,enc) = do
- -- Fake proofs for all values except the correct one.
- prevFakes <- fakeProof `mapM` prevDisjs
- nextFakes <- fakeProof `mapM` nextDisjs
- let prevProofs = fst <$> prevFakes
- let nextProofs = fst <$> nextFakes
- let challengeSum =
- sum (proof_challenge <$> prevProofs) +
- sum (proof_challenge <$> nextProofs)
+ -- Fake proofs for all 'Disjunction's except the genuine one.
+ prevFakeProofs <- replicateM (List.length prevDisjs) fakeProof
+ nextFakeProofs <- replicateM (List.length nextDisjs) fakeProof
+ let fakeChallengeSum =
+ sum (proof_challenge <$> prevFakeProofs) +
+ sum (proof_challenge <$> nextFakeProofs)
let statement = encryptionStatement voterZKP enc
- correctProof <- prove encNonce [groupGen, elecPubKey] $
- -- 'Oracle'
- \correctCommitments ->
- let commitments =
- foldMap snd prevFakes <>
- correctCommitments <>
- foldMap snd nextFakes in
- hash statement commitments - challengeSum
- return $ DisjProof $ prevProofs <> (correctProof : nextProofs)
- where
- fakeProof :: Disjunction q -> S.StateT r m (Proof q, [Commitment q])
- fakeProof disj = do
- -- Returns 'Commitment's verifiables by the verifier,
- -- but computed from random 'proof_challenge' and 'proof_response'
- -- instead of correct ones.
- proof_challenge <- random
- proof_response <- random
- let proof = Proof{..}
- return (proof, encryptionCommitments elecPubKey enc disj proof)
+ genuineProof <- prove encNonce [groupGen, elecPubKey] $ \genuineCommitments ->
+ let validCommitments = List.zipWith (encryptionCommitments elecPubKey enc) in
+ let prevCommitments = validCommitments prevDisjs prevFakeProofs in
+ let nextCommitments = validCommitments nextDisjs nextFakeProofs in
+ let commitments = join prevCommitments <> genuineCommitments <> join nextCommitments in
+ let challenge = hash statement commitments in
+ let genuineChallenge = challenge - fakeChallengeSum in
+ genuineChallenge
+ -- NOTE: here by construction (genuineChallenge == challenge - fakeChallengeSum)
+ -- thus (sum (proof_challenge <$> proofs) == challenge)
+ -- as checked in 'verifyEncryption'.
+ let proofs = prevFakeProofs <> (genuineProof : nextFakeProofs)
+ return (DisjProof proofs)
verifyEncryption ::
- Monad m =>
- SubGroup q =>
+ Monad m => SubGroup q =>
PublicKey q -> ZKP ->
- [Disjunction q] ->
- (Encryption q, DisjProof q) ->
+ [Disjunction q] -> (Encryption q, DisjProof q) ->
ExceptT ErrorVerifyEncryption m Bool
verifyEncryption elecPubKey voterZKP disjs (enc, DisjProof proofs) =
case isoZipWith (encryptionCommitments elecPubKey enc) disjs proofs of
-- | @('encryptionCommitments' elecPubKey enc disj proof)@
-- returns the 'Commitment's with only the knowledge of the verifier.
--
--- The 'Proof' comes from 'prove' of @fakeProof@ in 'proveEncryption'.
+-- For the prover the 'Proof' comes from @fakeProof@,
+-- and for the verifier the 'Proof' comes from the prover.
encryptionCommitments ::
SubGroup q =>
PublicKey q -> Encryption q ->
Disjunction q -> Proof q -> [G q]
encryptionCommitments elecPubKey Encryption{..} disj proof =
[ commit proof groupGen encryption_nonce
- -- == groupGen ^ nonce if 'Proof' comes from 'prove'
+ -- == groupGen ^ nonce if 'Proof' comes from 'prove'.
+ -- base==groupGen, basePowSec==groupGen^encNonce.
, commit proof elecPubKey (encryption_vault*disj)
-- == elecPubKey ^ nonce if 'Proof' comes from 'prove'
-- and 'encryption_vault' encrypts (- logBase groupGen disj).
+ -- base==elecPubKey, basePowSec==elecPubKey^encNonce.
]
-- ** Type 'ErrorVerifyEncryption'
sourcephile / git / majurity.git / commitdiff