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