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