hjugement-protocol/Protocol/Election.hs

   1 {-# LANGUAGE DataKinds #-}
   2 {-# LANGUAGE GADTs #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4 module Protocol.Election where
   5
   6 import Control.Monad (Monad(..), join, mapM, zipWithM)
   7 import Control.Monad.Morph (MFunctor(..))
   8 import Control.Monad.Trans.Class (MonadTrans(..))
   9 import Data.Bool
  10 import Data.Either (either)
  11 import Data.Eq (Eq(..))
  12 import Data.Foldable (Foldable, foldMap, and)
  13 import Data.Function (($), id, const)
  14 import Data.Functor (Functor, (<$>))
  15 import Data.Functor.Identity (Identity(..))
  16 import Data.Maybe (Maybe(..), fromMaybe)
  17 import Data.Ord (Ord(..))
  18 import Data.Semigroup (Semigroup(..))
  19 import Data.Text (Text)
  20 import Data.Traversable (Traversable(..))
  21 import Data.Tuple (fst, snd, uncurry)
  22 import GHC.Natural (minusNaturalMaybe)
  23 import Numeric.Natural (Natural)
  24 import Prelude (error, fromIntegral)
  25 import Text.Show (Show(..))
  26 import qualified Control.Monad.Trans.Except as Exn
  27 import qualified Control.Monad.Trans.State.Strict as S
  28 import qualified Data.ByteString as BS
  29 import qualified Data.List as List
  30
  31 import Protocol.Arithmetic
  32 import Protocol.Credential
  33
  34 -- * Type 'Encryption'
  35 -- | ElGamal-like encryption.
  36 -- Its security relies on the /Discrete Logarithm problem/.
  37 --
  38 -- Because ('groupGen' '^'encNonce '^'secKey '==' 'groupGen' '^'secKey '^'encNonce),
  39 -- knowing @secKey@, one can divide 'encryption_vault' by @('encryption_nonce' '^'secKey)@
  40 -- to decipher @('groupGen' '^'clear)@, then the @clear@ text must be small to be decryptable,
  41 -- because it is encrypted as a power of 'groupGen' (hence the "-like" in "ElGamal-like")
  42 -- to enable the additive homomorphism.
  43 --
  44 -- NOTE: Since @('encryption_vault' '*' 'encryption_nonce' '==' 'encryption_nonce' '^' (secKey '+' clear))@,
  45 -- then: @(logBase 'encryption_nonce' ('encryption_vault' '*' 'encryption_nonce') '==' secKey '+' clear)@.
  46 data Encryption q = Encryption
  47  { encryption_nonce :: G q
  48    -- ^ Public part of the randomness 'encNonce' used to 'encrypt' the 'clear' text,
  49    -- equal to @('groupGen' '^'encNonce)@
  50  , encryption_vault :: G q
  51    -- ^ Encrypted 'clear' text, equal to @('pubKey' '^'r '*' 'groupGen' '^'clear)@
  52  } deriving (Eq,Show)
  53
  54 -- | Additive homomorphism.
  55 -- Using the fact that: @'groupGen' '^'x '*' 'groupGen' '^'y '==' 'groupGen' '^'(x'+'y)@.
  56 instance SubGroup q => Additive (Encryption q) where
  57         zero = Encryption one one
  58         x+y = Encryption
  59          (encryption_nonce x * encryption_nonce y)
  60          (encryption_vault x * encryption_vault y)
  61
  62 -- *** Type 'EncryptionNonce'
  63 type EncryptionNonce = E
  64
  65 -- | @('encrypt' pubKey clear)@ returns an ElGamal-like 'Encryption'.
  66 --
  67 -- WARNING: the secret encryption nonce (@encNonce@)
  68 -- is returned alongside the 'Encryption'
  69 -- in order to 'prove' the validity of the encrypted 'clear' text in 'proveEncryption',
  70 -- but this secret @encNonce@ MUST be forgotten after that,
  71 -- as it may be used to decipher the 'Encryption'
  72 -- without the secret key associated with 'pubKey'.
  73 encrypt ::
  74  Monad m => RandomGen r => SubGroup q =>
  75  PublicKey q -> E q ->
  76  S.StateT r m (EncryptionNonce q, Encryption q)
  77 encrypt pubKey clear = do
  78         encNonce <- random
  79         -- NOTE: preserve the 'encNonce' for 'prove' in 'proveEncryption'.
  80         return $ (encNonce,)
  81                 Encryption
  82                  { encryption_nonce = groupGen^encNonce
  83                  , encryption_vault = pubKey  ^encNonce * groupGen^clear
  84                  }
  85
  86 -- * Type 'Proof'
  87 -- | 'Proof' of knowledge of a discrete logarithm:
  88 -- @(secret == logBase base (base^secret))@.
  89 data Proof q = Proof
  90  { proof_challenge :: Challenge q
  91    -- ^ 'Challenge' sent by the verifier to the prover
  92    -- to ensure that the prover really has knowledge
  93    -- of the secret and is not replaying.
  94    -- Actually, 'proof_challenge' is not sent to the prover,
  95    -- but derived from the prover's 'Commitment's and statements
  96    -- with a collision resistant 'hash'.
  97    -- Hence the prover cannot chose the 'proof_challenge' to his/her liking.
  98  , proof_response :: E q
  99    -- ^ A discrete logarithm sent by the prover to the verifier,
 100    -- as a response to 'proof_challenge'.
 101    --
 102    -- If the verifier observes that @('proof_challenge' '==' 'hash' statement [commitment])@
 103    -- where:
 104    --
 105    -- * @statement@ is a serialization of a tag, 'base' and 'basePowSec',
 106    -- * @(commitment '==' 'commit' proof base basePowSec '=='
 107    --   base '^' 'proof_response' '*' basePowSec '^' 'proof_challenge')@,
 108    -- * and @(basePowSec '==' base'^'sec)@,
 109    --
 110    -- then with overwhelming probability due to the 'hash' function:
 111    -- @(commitment '==' base'^'nonce)@.
 112    -- Therefore by expanding 'commitment':
 113    -- @('proof_response' '==' logBase base (base'^'nonce) '-' logBase basePowSec (basePowSec '^' 'proof_challenge'))@,
 114    -- which means that the prover must have known 'nonce' and 'sec'
 115    -- to compute 'proof_response' efficiently with:
 116    -- @('proof_response' '==' nonce '-' sec '*' 'proof_challenge')@,
 117    --
 118    -- The 'nonce' is introduced to ensure each 'prove' does not reveal
 119    -- any information regarding the prover's secret 'sec',
 120    -- by being randomly chosen by the prover.
 121  } deriving (Eq,Show)
 122
 123 -- ** Type 'ZKP'
 124 -- | Zero-knowledge proof
 125 --
 126 -- DOC: Mihir Bellare and Phillip Rogaway. Random oracles are practical:
 127 --      A paradigm for designing efficient protocols. In ACM-CCS’93, 1993.
 128 --
 129 -- DOC: Pierrick Gaudry. <https://hal.inria.fr/hal-01576379 Some ZK security proofs for Belenios>, 2017.
 130 newtype ZKP = ZKP BS.ByteString
 131
 132 -- ** Type 'Challenge'
 133 type Challenge = E
 134
 135 -- ** Type 'Oracle'
 136 -- An 'Oracle' returns the 'Challenge' of the 'Commitment's
 137 -- by 'hash'ing them (eventually with other 'Commitment's).
 138 --
 139 -- Used in 'prove' it enables a Fiat-Shamir transformation
 140 -- of an /interactive zero-knowledge/ (IZK) proof
 141 -- into a /non-interactive zero-knowledge/ (NIZK) proof.
 142 -- That is to say that the verifier does not have
 143 -- to send a 'Challenge' to the prover.
 144 -- Indeed, the prover now handles the 'Challenge'
 145 -- which becomes a (collision resistant) 'hash'
 146 -- of the prover's commitments (and statements to be a stronger proof).
 147 type Oracle list q = list (Commitment q) -> Challenge q
 148
 149 -- | @('prove' sec commitBases oracle)@
 150 -- returns a 'Proof' that @sec@ is known.
 151 --
 152 -- The 'Oracle' is given the 'commitBases'
 153 -- raised to the power of the secret nonce of the 'Proof',
 154 -- as those are the 'commitBases' that the verifier will obtain
 155 -- when composing the 'proof_challenge' and 'proof_response' together
 156 -- (in 'commit').
 157 --
 158 -- NOTE: 'sec' is @secKey@ in 'signature_proof' or @encNonce@ in 'proveEncryption'.
 159 --
 160 -- WARNING: for 'prove' to be a so-called /strong Fiat-Shamir transformation/ (not a weak):
 161 -- the statement must be included in the 'hash' (not only the commitments).
 162 --
 163 -- NOTE: a 'random' @nonce@ is used to ensure each 'prove'
 164 -- does not reveal any information regarding the secret 'sec'.
 165 prove ::
 166  Monad m => RandomGen r => SubGroup q => Functor list =>
 167  E q -> list (Commitment q) -> Oracle list q -> S.StateT r m (Proof q)
 168 prove sec commitBases oracle = do
 169         nonce <- random
 170         let proof_challenge = oracle $ (^ nonce) <$> commitBases
 171         return Proof
 172          { proof_challenge
 173          , proof_response = nonce - sec*proof_challenge
 174          }
 175
 176 -- ** Type 'Commitment'
 177 type Commitment = G
 178
 179 -- | @('commit' proof base basePowSec)@ returns a 'Commitment'
 180 -- from the given 'Proof' with the knowledge of the verifier.
 181 commit :: SubGroup q => Proof q -> G q -> G q -> Commitment q
 182 commit Proof{..} base basePowSec =
 183         base^proof_response *
 184         basePowSec^proof_challenge
 185   -- NOTE: Contrary to some textbook presentations,
 186   -- @('*')@ is used instead of @('/')@ to avoid the performance cost
 187   -- of a modular exponentiation @('^' ('groupOrder' '-' 'one'))@,
 188   -- this is compensated by using @('-')@ instead of @('+')@ in 'prove'.
 189 {-# INLINE commit #-}
 190
 191 -- * Type 'Disjunction'
 192 -- | A 'Disjunction' is an 'inv'ersed @('groupGen' '^'opinion)@
 193 -- it's used in 'proveEncryption' to generate a 'Proof'
 194 -- that an 'encryption_vault' contains a given @('groupGen' '^'opinion)@,
 195 type Disjunction = G
 196
 197 booleanDisjunctions :: SubGroup q => [Disjunction q]
 198 booleanDisjunctions = List.take 2 groupGenInverses
 199
 200 intervalDisjunctions :: SubGroup q => Opinion q -> Opinion q -> [Disjunction q]
 201 intervalDisjunctions mini maxi =
 202         List.genericTake (fromMaybe 0 $ (nat maxi + 1)`minusNaturalMaybe`nat mini) $
 203         List.genericDrop (nat mini) $
 204         groupGenInverses
 205
 206 -- ** Type 'Opinion'
 207 -- | Index of a 'Disjunction' within a list of them.
 208 -- It is encrypted as an 'E'xponent by 'encrypt'.
 209 type Opinion = E
 210
 211 -- ** Type 'DisjProof'
 212 -- | A list of 'Proof's to prove that the 'Opinion' within an 'Encryption'
 213 -- is indexing a 'Disjunction' within a list of them,
 214 -- without knowing which 'Opinion' it is.
 215 newtype DisjProof q = DisjProof [Proof q]
 216  deriving (Eq,Show)
 217
 218 -- * 'proveEncryption' and 'verifyEncryption'
 219 -- | @('proveEncryption' elecPubKey voterZKP disjs opin (encNonce, enc))@
 220 -- returns a 'DisjProof' that 'enc' 'encrypt's
 221 -- one of the 'Disjunction's within 'disjs',
 222 -- without revealing which one it is.
 223 --
 224 -- A /NIZK Disjunctive Chaum Pedersen Logarithm Equality/ is used.
 225 proveEncryption ::
 226  forall m r q.
 227  Monad m => RandomGen r => SubGroup q =>
 228  PublicKey q -> ZKP ->
 229  [Disjunction q] -> Opinion q ->
 230  (EncryptionNonce q, Encryption q) ->
 231  S.StateT r (Exn.ExceptT ErrorProve m) (DisjProof q)
 232 proveEncryption elecPubKey voterZKP disjs opinion (encNonce, enc)
 233  | (prevDisjs, _indexedDisj:nextDisjs) <-
 234    List.genericSplitAt (nat opinion) disjs = do
 235         -- Fake proofs for all values except the correct one.
 236         prevFakes <- fakeProof `mapM` prevDisjs
 237         nextFakes <- fakeProof `mapM` nextDisjs
 238         let prevProofs = fst <$> prevFakes
 239         let nextProofs = fst <$> nextFakes
 240         let challengeSum =
 241                 sum (proof_challenge <$> prevProofs) +
 242                 sum (proof_challenge <$> nextProofs)
 243         let statement = encryptionStatement voterZKP enc
 244         correctProof <- prove encNonce [groupGen, elecPubKey] $
 245          -- 'Oracle'
 246          \correctCommitments ->
 247                 let commitments =
 248                         foldMap snd prevFakes <>
 249                         correctCommitments <>
 250                         foldMap snd nextFakes in
 251                 hash statement commitments - challengeSum
 252         return $ DisjProof $ prevProofs <> (correctProof : nextProofs)
 253  | otherwise = lift $ Exn.throwE $
 254         ErrorProve_InvalidOpinion
 255          (nat opinion)
 256          (fromIntegral $ List.length disjs)
 257         where
 258         fakeProof :: Disjunction q -> S.StateT r (Exn.ExceptT ErrorProve m) (Proof q, [Commitment q])
 259         fakeProof disj = do
 260                 -- Returns 'Commitment's verifiables by the verifier,
 261                 -- but computed from random 'proof_challenge' and 'proof_response'
 262                 -- instead of correct ones.
 263                 proof_challenge <- random
 264                 proof_response  <- random
 265                 let proof = Proof{..}
 266                 return (proof, encryptionCommitments elecPubKey enc (disj, proof))
 267
 268 verifyEncryption ::
 269  Monad m =>
 270  SubGroup q =>
 271  PublicKey q -> ZKP ->
 272  [Disjunction q] ->
 273  (Encryption q, DisjProof q) ->
 274  Exn.ExceptT ErrorValidateEncryption m Bool
 275 verifyEncryption elecPubKey voterZKP disjs (enc, DisjProof proofs)
 276  | List.length proofs /= List.length disjs =
 277         Exn.throwE $ ErrorValidateEncryption_InvalidProofLength
 278          (fromIntegral $ List.length proofs)
 279          (fromIntegral $ List.length disjs)
 280  | otherwise = return $ challengeSum == hash (encryptionStatement voterZKP enc) commitments
 281         where
 282         challengeSum = sum (proof_challenge <$> proofs)
 283         commitments = foldMap (encryptionCommitments elecPubKey enc) (List.zip disjs proofs)
 284
 285 -- ** Hashing
 286 encryptionStatement :: SubGroup q => ZKP -> Encryption q -> BS.ByteString
 287 encryptionStatement (ZKP voterZKP) Encryption{..} =
 288         "prove|"<>voterZKP<>"|"
 289          <> bytesNat encryption_nonce<>","
 290          <> bytesNat encryption_vault<>"|"
 291         -- NOTE: the commitment base 'elecPubKey' is notably absent here
 292         -- despite it being used in 'encryptionCommitments',
 293         -- maybe this is not necessary because it is already known
 294         -- by every participant.
 295
 296 -- | @('encryptionCommitments' elecPubKey enc (disj,proof))@
 297 -- returns the 'Commitment's with only the knowledge of the verifier.
 298 --
 299 -- The 'Proof' comes from 'prove' of @fakeProof@ in 'proveEncryption'.
 300 encryptionCommitments ::
 301  SubGroup q =>
 302  PublicKey q -> Encryption q ->
 303  (Disjunction q, Proof q) -> [G q]
 304 encryptionCommitments elecPubKey Encryption{..} (disj, proof) =
 305         [ commit proof groupGen encryption_nonce
 306           -- == groupGen ^ nonce if 'Proof' comes from 'prove'
 307         , commit proof elecPubKey (encryption_vault*disj)
 308           -- == elecPubKey ^ nonce if 'Proof' comes from 'prove'
 309           -- and 'encryption_vault' encrypts (- logBase groupGen disj).
 310         ]
 311
 312 -- ** Type 'ErrorProve'
 313 -- | Error raised by 'proveEncryption'.
 314 data ErrorProve
 315  =   ErrorProve_InvalidOpinion Natural Natural
 316      -- ^ When the opinion (first) is not within the number of 'Disjunction's (second).
 317  deriving (Eq,Show)
 318
 319 -- ** Type 'ErrorValidateEncryption'
 320 -- | Error raised by 'verifyEncryption'.
 321 data ErrorValidateEncryption
 322  =   ErrorValidateEncryption_InvalidProofLength Natural Natural
 323      -- ^ When the number of proofs is different than
 324      -- the number of 'Disjunction's.
 325  deriving (Eq,Show)
 326
 327 -- * Type 'Question'
 328 data Question q = Question
 329  { question_text    :: Text
 330  , question_choices :: [Text]
 331  , question_mini    :: Opinion q
 332  , question_maxi    :: Opinion q
 333  -- , question_blank :: Maybe Bool
 334  } deriving (Eq, Show)
 335
 336 -- * Type 'Answer'
 337 data Answer q = Answer
 338  { answer_opinions :: [(Encryption q, DisjProof q)]
 339    -- ^ Encrypted 'Opinion' for each 'question_choices'
 340    -- with a 'DisjProof' that they belong to [0,1].
 341  , answer_sumProof :: DisjProof q
 342    -- ^ Proofs that the sum of the 'Opinon's encrypted in 'answer_opinions'
 343    -- is an element of @[mini..maxi]@.
 344  -- , answer_blankProof ::
 345  } deriving (Eq,Show)
 346
 347 -- | @('encryptAnswer' elecPubKey zkp quest opinions)@
 348 -- returns an 'Answer' validable by 'verifyAnswer',
 349 -- unless an 'ErrorAnswer' is returned.
 350 encryptAnswer ::
 351  Monad m => RandomGen r => SubGroup q =>
 352  PublicKey q -> ZKP ->
 353  Question q -> [Bool] ->
 354  S.StateT r (Exn.ExceptT ErrorAnswer m) (Answer q)
 355 encryptAnswer elecPubKey zkp Question{..} opinionsBools
 356  | not (question_mini <= opinionsSum && opinionsSum <= question_maxi) =
 357         lift $ Exn.throwE $
 358                 ErrorAnswer_WrongSumOfOpinions
 359                  (nat opinionsSum)
 360                  (nat question_mini)
 361                  (nat question_maxi)
 362  | List.length opinions /= List.length question_choices =
 363         lift $ Exn.throwE $
 364                 ErrorAnswer_WrongNumberOfOpinions
 365                  (fromIntegral $ List.length opinions)
 366                  (fromIntegral $ List.length question_choices)
 367  | otherwise = do
 368         encryptions <- encrypt elecPubKey `mapM` opinions
 369         hoist (Exn.withExceptT (\case
 370                  ErrorProve_InvalidOpinion{} -> error "encryptAnswer: impossible happened"
 371          )) $ do
 372                 individualProofs <- zipWithM
 373                  (proveEncryption elecPubKey zkp booleanDisjunctions)
 374                  opinions encryptions
 375                 sumProof <- proveEncryption elecPubKey zkp
 376                  (intervalDisjunctions question_mini question_maxi)
 377                  (opinionsSum - question_mini)
 378                  ( sum (fst <$> encryptions) -- NOTE: sum the 'encNonce's
 379                  , sum (snd <$> encryptions) -- NOTE: sum the 'Encryption's
 380                  )
 381                 return $ Answer
 382                  { answer_opinions = List.zip
 383                          (snd <$> encryptions) -- NOTE: drop encNonce
 384                          individualProofs
 385                  , answer_sumProof = sumProof
 386                  }
 387  where
 388         opinionsSum = sum opinions
 389         opinions = (\o -> if o then one else zero) <$> opinionsBools
 390
 391 verifyAnswer ::
 392  SubGroup q =>
 393  PublicKey q -> ZKP ->
 394  Question q -> Answer q -> Bool
 395 verifyAnswer elecPubKey zkp Question{..} Answer{..}
 396  | List.length question_choices /= List.length answer_opinions = False
 397  | otherwise = either (const False) id $ Exn.runExcept $ do
 398         validOpinions <-
 399                 verifyEncryption elecPubKey zkp booleanDisjunctions
 400                  `traverse` answer_opinions
 401         validSum <- verifyEncryption elecPubKey zkp
 402          (intervalDisjunctions question_mini question_maxi)
 403          ( sum (fst <$> answer_opinions)
 404          , answer_sumProof )
 405         return (and validOpinions && validSum)
 406
 407 -- ** Type 'ErrorAnswer'
 408 -- | Error raised by 'encryptAnswer'.
 409 data ErrorAnswer
 410  =   ErrorAnswer_WrongNumberOfOpinions Natural Natural
 411      -- ^ When the number of opinions is different than
 412      -- the number of choices ('question_choices').
 413  |   ErrorAnswer_WrongSumOfOpinions Natural Natural Natural
 414      -- ^ When the sum of opinions is not within the bounds
 415      -- of 'question_mini' and 'question_maxi'.
 416  deriving (Eq,Show)
 417
 418 -- * Type 'Election'
 419 data Election q = Election
 420  { election_name        :: Text
 421  , election_description :: Text
 422  , election_publicKey   :: PublicKey q
 423  , election_questions   :: [Question q]
 424  , election_uuid        :: UUID
 425  , election_hash        :: Hash -- TODO: serialize to JSON to calculate this
 426  } deriving (Eq,Show)
 427
 428 -- ** Type 'Hash'
 429 newtype Hash = Hash Text
 430  deriving (Eq,Ord,Show)
 431
 432 -- * Type 'Ballot'
 433 data Ballot q = Ballot
 434  { ballot_answers       :: [Answer q]
 435  , ballot_signature     :: Maybe (Signature q)
 436  , ballot_election_uuid :: UUID
 437  , ballot_election_hash :: Hash
 438  }
 439
 440 -- | @('encryptBallot' elec ('Just' secKey) opinionsByQuest)@
 441 -- returns a 'Ballot' signed by 'secKey' (the voter's secret key)
 442 -- where 'opinionsByQuest' is a list of 'Opinion's
 443 -- on each 'question_choices' of each 'election_questions'.
 444 encryptBallot ::
 445  Monad m => RandomGen r => SubGroup q =>
 446  Election q -> Maybe (SecretKey q) -> [[Bool]] ->
 447  S.StateT r (Exn.ExceptT ErrorBallot m) (Ballot q)
 448 encryptBallot Election{..} secKeyMay opinionsByQuest
 449  | List.length election_questions /= List.length opinionsByQuest =
 450         lift $ Exn.throwE $
 451                 ErrorBallot_WrongNumberOfAnswers
 452                  (fromIntegral $ List.length opinionsByQuest)
 453                  (fromIntegral $ List.length election_questions)
 454  | otherwise = do
 455         let (voterKeys, voterZKP) =
 456                 case secKeyMay of
 457                  Nothing -> (Nothing, ZKP "")
 458                  Just secKey ->
 459                         ( Just (secKey, pubKey)
 460                         , ZKP (bytesNat pubKey) )
 461                         where pubKey = publicKey secKey
 462         ballot_answers <-
 463                 hoist (Exn.withExceptT ErrorBallot_Answer) $
 464                         zipWithM (encryptAnswer election_publicKey voterZKP)
 465                          election_questions opinionsByQuest
 466         ballot_signature <- case voterKeys of
 467          Nothing -> return Nothing
 468          Just (secKey, signature_publicKey) -> do
 469                 signature_proof <-
 470                         prove secKey (Identity groupGen) $
 471                          \(Identity commitment) ->
 472                                 hash
 473                                  -- NOTE: the order is unusual, the commitments are first
 474                                  -- then comes the statement. Best guess is that
 475                                  -- this is easier to code due to their respective types.
 476                                  (signatureCommitments voterZKP commitment)
 477                                  (signatureStatement ballot_answers)
 478                 return $ Just Signature{..}
 479         return Ballot
 480          { ballot_answers
 481          , ballot_election_hash = election_hash
 482          , ballot_election_uuid = election_uuid
 483          , ballot_signature
 484          }
 485
 486 verifyBallot :: SubGroup q => Election q -> Ballot q -> Bool
 487 verifyBallot Election{..} Ballot{..} =
 488         ballot_election_uuid == election_uuid &&
 489         ballot_election_hash == election_hash &&
 490         List.length election_questions == List.length ballot_answers &&
 491         let (isValidSign, zkpSign) =
 492                 case ballot_signature of
 493                  Nothing -> (True, ZKP "")
 494                  Just Signature{..} ->
 495                         let zkp = ZKP (bytesNat signature_publicKey) in
 496                         (, zkp) $
 497                                 proof_challenge signature_proof == hash
 498                                  (signatureCommitments zkp (commit signature_proof groupGen signature_publicKey))
 499                                  (signatureStatement ballot_answers)
 500         in
 501         and $ isValidSign :
 502                 List.zipWith (verifyAnswer election_publicKey zkpSign)
 503                  election_questions ballot_answers
 504
 505 -- ** Type 'Signature'
 506 -- | Schnorr-like signature.
 507 --
 508 -- Used by each voter to sign his/her encrypted 'Ballot'
 509 -- using his/her 'Credential',
 510 -- in order to avoid ballot stuffing.
 511 data Signature q = Signature
 512  { signature_publicKey :: PublicKey q
 513    -- ^ Verification key.
 514  , signature_proof     :: Proof q
 515  }
 516
 517 -- *** Hashing
 518
 519 -- | @('signatureStatement' answers)@
 520 -- returns the encrypted material to be signed:
 521 -- all the 'encryption_nonce's and 'encryption_vault's of the given @answers@.
 522 signatureStatement :: Foldable f => SubGroup q => f (Answer q) -> [G q]
 523 signatureStatement =
 524         foldMap $ \Answer{..} ->
 525                 (`foldMap` answer_opinions) $ \(Encryption{..}, _proof) ->
 526                         [encryption_nonce, encryption_vault]
 527
 528 -- | @('signatureCommitments' voterZKP commitment)@
 529 signatureCommitments :: SubGroup q => ZKP -> Commitment q -> BS.ByteString
 530 signatureCommitments (ZKP voterZKP) commitment =
 531         "sig|"<>voterZKP<>"|"<>bytesNat commitment<>"|"
 532
 533 -- ** Type 'ErrorBallot'
 534 -- | Error raised by 'encryptBallot'.
 535 data ErrorBallot
 536  =   ErrorBallot_WrongNumberOfAnswers Natural Natural
 537      -- ^ When the number of answers
 538      -- is different than the number of questions.
 539  |   ErrorBallot_Answer ErrorAnswer
 540      -- ^ When 'encryptAnswer' raised an 'ErrorAnswer'.
 541  deriving (Eq,Show)