hjugement-protocol/Protocol/Election.hs

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