hjugement-web/src/Voting/Protocol/Cryptography.purs

   1 module Voting.Protocol.Cryptography where
   2
   3 import Control.Applicative (pure, (<*>))
   4 import Control.Monad (bind, join)
   5 import Control.Monad.Trans.Class (lift)
   6 import Control.Monad.Except.Trans (ExceptT, throwError)
   7 import Data.Argonaut.Core as JSON
   8 import Data.Argonaut.Decode (class DecodeJson, decodeJson, (.:))
   9 import Data.Argonaut.Encode (class EncodeJson, encodeJson, (:=), (:=?), (~>), (~>?))
  10 import Data.Argonaut.Parser as JSON
  11 import Data.BigInt (BigInt)
  12 import Data.BigInt as BigInt
  13 import Data.Boolean (otherwise)
  14 import Data.Bounded (class Bounded, top)
  15 import Data.Either (Either(..))
  16 import Data.Eq (class Eq, (==), (/=))
  17 import Data.EuclideanRing (class EuclideanRing, (/), mod)
  18 import Data.Foldable (intercalate)
  19 import Data.Function (($), identity, (<<<), flip)
  20 import Data.Functor (class Functor, (<$>))
  21 import Data.HeytingAlgebra ((&&))
  22 import Data.Int as Int
  23 import Data.List (List, (:))
  24 import Data.List as List
  25 import Data.List.Lazy as LL
  26 import Data.Maybe (Maybe(..), maybe, fromJust)
  27 import Data.Monoid (class Monoid, mempty, (<>))
  28 import Data.Newtype (class Newtype, wrap, unwrap)
  29 import Data.Ord (class Ord, (>=))
  30 import Data.Reflection (class Reifies, reflect)
  31 import Data.Ring (class Ring, (-), negate)
  32 import Data.Semiring (class Semiring, zero, (+), one, (*))
  33 import Data.Show (class Show, show)
  34 import Data.String.CodeUnits as String
  35 import Data.Traversable (sum)
  36 import Data.Tuple (Tuple(..))
  37 import Data.Unfoldable (replicateA)
  38 import Effect (Effect)
  39 import Effect.Random (randomInt)
  40 import Node.Crypto as Crypto
  41 import Node.Crypto.Hash as Crypto
  42 import Partial.Unsafe (unsafePartial)
  43 import Type.Proxy (Proxy(..))
  44
  45 import Voting.Protocol.Utils
  46 import Voting.Protocol.Arithmetic
  47 import Voting.Protocol.Version
  48
  49 -- * Type 'PublicKey'
  50 type PublicKey = G
  51 -- * Type 'SecretKey'
  52 type SecretKey = E
  53
  54 -- * Type 'Hash'
  55 newtype Hash crypto c = Hash (E crypto c)
  56 derive newtype instance eqHash   :: Eq   (Hash crypto c)
  57 derive newtype instance ordHash  :: Ord  (Hash crypto c)
  58 derive newtype instance showHash :: Show (Hash crypto c)
  59
  60 {-
  61 -- | @('hash' bs gs)@ returns as a number in 'G'
  62 -- the 'Crypto.SHA256' hash of the given 'BS.ByteString' 'bs'
  63 -- prefixing the decimal representation of given subgroup elements 'gs',
  64 -- with a comma (",") intercalated between them.
  65 --
  66 -- NOTE: to avoid any collision when the 'hash' function is used in different contexts,
  67 -- a message 'gs' is actually prefixed by a 'bs' indicating the context.
  68 --
  69 -- Used by 'proveEncryption' and 'verifyEncryption',
  70 -- where the 'bs' usually contains the 'statement' to be proven,
  71 -- and the 'gs' contains the 'commitments'.
  72 -}
  73 hash ::
  74  forall crypto c.
  75  CryptoParams crypto c =>
  76  String -> List (G crypto c) ->
  77  Effect (E crypto c)
  78 hash bs gs = do
  79   let s = bs <> intercalate "," (bytesNat <$> gs)
  80   h <- Crypto.hex Crypto.SHA256 s
  81   pure $ fromNatural $ Natural $
  82     unsafePartial $ fromJust $
  83     BigInt.fromBase 16 h
  84
  85 -- | `('bytesNat' x)` returns the serialization of `x`.
  86 bytesNat :: forall n. ToNatural n => n -> String
  87 bytesNat = show <<< nat
  88
  89 -- | `'randomBigInt' low high` returns a random 'BigInt' within `low` and `high`.
  90 --
  91 -- NOTE: adapted from GHC's 'randomIvalInteger'
  92 randomBigInt :: BigInt -> BigInt -> Effect BigInt
  93 randomBigInt l h = do
  94   v <- f one zero
  95   pure (l + v `mod` k)
  96   where
  97   srcLow  = one :: Int
  98   srcHigh = top :: Int
  99   -- | source interval
 100   b = BigInt.fromInt srcHigh - BigInt.fromInt srcLow + one
 101   -- | target interval
 102   k = h - l + one
 103   -- Probabilities of the most likely and least likely result
 104   -- will differ at most by a factor of (1 +- 1/q).
 105   -- Assuming the 'random' is uniform, of course.
 106   -- On average, log q / log b more random values will be generated
 107   -- than the minimum.
 108   q = BigInt.fromInt 1000
 109   targetMagnitude = k * q
 110   -- Generate random values until we exceed the target magnitude.
 111   f mag acc
 112    | mag >= targetMagnitude = pure acc
 113    | otherwise = do
 114      r <- randomInt srcLow srcHigh
 115      f (mag * b)
 116        (acc * b + (BigInt.fromInt r - BigInt.fromInt srcLow))
 117
 118 randomE ::
 119  forall crypto c.
 120  CryptoParams crypto c =>
 121  Effect (E crypto c)
 122 randomE = E <<< Natural <$> randomBigInt zero (unwrap (nat (top::E crypto c)))
 123
 124 -- * Type 'Encryption'
 125 -- | ElGamal-like encryption.
 126 -- Its security relies on the /Discrete Logarithm problem/.
 127 --
 128 -- Because ('groupGen' '^'encNonce '^'secKey '==' 'groupGen' '^'secKey '^'encNonce),
 129 -- knowing @secKey@, one can divide 'encryption_vault' by @('encryption_nonce' '^'secKey)@
 130 -- to decipher @('groupGen' '^'clear)@, then the @clear@ text must be small to be decryptable,
 131 -- because it is encrypted as a power of 'groupGen' (hence the "-like" in "ElGamal-like")
 132 -- to enable the additive homomorphism.
 133 --
 134 -- NOTE: Since @('encryption_vault' '*' 'encryption_nonce' '==' 'encryption_nonce' '^' (secKey '+' clear))@,
 135 -- then: @(logBase 'encryption_nonce' ('encryption_vault' '*' 'encryption_nonce') '==' secKey '+' clear)@.
 136 data Encryption crypto v c = Encryption
 137  { encryption_nonce :: G crypto c
 138    -- ^ Public part of the randomness 'encNonce' used to 'encrypt' the 'clear' text,
 139    -- equal to @('groupGen' '^'encNonce)@
 140  , encryption_vault :: G crypto c
 141    -- ^ Encrypted 'clear' text,
 142    -- equal to @('pubKey' '^'encNone '*' 'groupGen' '^'clear)@
 143  }
 144 derive instance eqEncryption :: Eq (G crypto c) => Eq (Encryption crypto v c)
 145 instance showEncryption :: Show (G crypto c) => Show (Encryption crypto v c) where
 146   show (Encryption e) = show e
 147 instance encodeJsonEncryption ::
 148  ( Reifies v Version
 149  , CryptoParams crypto c
 150  ) => EncodeJson (Encryption crypto v c) where
 151   encodeJson (Encryption{encryption_nonce, encryption_vault}) =
 152     "alpha" := encryption_nonce ~>
 153     "beta"  := encryption_vault ~>
 154     JSON.jsonEmptyObject
 155 instance decodeJsonEncryption ::
 156  ( Reifies v Version
 157  , CryptoParams crypto c
 158  ) => DecodeJson (Encryption crypto v c) where
 159   decodeJson json = do
 160     obj <- decodeJson json
 161     encryption_nonce <- obj .: "alpha"
 162     encryption_vault <- obj .: "beta"
 163     pure $ Encryption{encryption_nonce, encryption_vault}
 164
 165 -- | Additive homomorphism.
 166 -- Using the fact that: @'groupGen' '^'x '*' 'groupGen' '^'y '==' 'groupGen' '^'(x'+'y)@.
 167 instance additiveEncryption ::
 168  CryptoParams crypto c =>
 169  Additive (Encryption crypto v c) where
 170   gzero = Encryption{encryption_nonce:one, encryption_vault:one}
 171   gadd (Encryption x) (Encryption y) = Encryption
 172    { encryption_nonce: x.encryption_nonce * y.encryption_nonce
 173    , encryption_vault: x.encryption_vault * y.encryption_vault
 174    }
 175
 176 -- *** Type 'EncryptionNonce'
 177 type EncryptionNonce = E
 178
 179 -- | @('encrypt' pubKey clear)@ returns an ElGamal-like 'Encryption'.
 180 --
 181 -- WARNING: the secret encryption nonce (@encNonce@)
 182 -- is returned alongside the 'Encryption'
 183 -- in order to 'prove' the validity of the encrypted 'clear' text in 'proveEncryption',
 184 -- but this secret @encNonce@ MUST be forgotten after that,
 185 -- as it may be used to decipher the 'Encryption'
 186 -- without the 'SecretKey' associated with 'pubKey'.
 187 encrypt ::
 188  forall crypto v c.
 189  Reifies v Version =>
 190  CryptoParams crypto c =>
 191  PublicKey crypto c -> E crypto c ->
 192  Effect (Tuple (EncryptionNonce crypto c) (Encryption crypto v c))
 193 encrypt pubKey clear = do
 194   encNonce <- randomE
 195   -- NOTE: preserve the 'encNonce' for 'prove' in 'proveEncryption'.
 196   pure $ Tuple encNonce $
 197     Encryption
 198      { encryption_nonce: groupGen^encNonce
 199      , encryption_vault: pubKey  ^encNonce * groupGen^clear
 200      }
 201
 202 -- * Type 'Proof'
 203 -- | Non-Interactive Zero-Knowledge 'Proof'
 204 -- of knowledge of a discrete logarithm:
 205 -- @(secret == logBase base (base^secret))@.
 206 data Proof crypto v c = Proof
 207  { proof_challenge :: Challenge crypto c
 208    -- ^ 'Challenge' sent by the verifier to the prover
 209    -- to ensure that the prover really has knowledge
 210    -- of the secret and is not replaying.
 211    -- Actually, 'proof_challenge' is not sent to the prover,
 212    -- but derived from the prover's 'Commitment's and statements
 213    -- with a collision resistant 'hash'.
 214    -- Hence the prover cannot chose the 'proof_challenge' to his/her liking.
 215  , proof_response :: E crypto c
 216    -- ^ A discrete logarithm sent by the prover to the verifier,
 217    -- as a response to 'proof_challenge'.
 218    --
 219    -- If the verifier observes that @('proof_challenge' '==' 'hash' statement [commitment])@, where:
 220    --
 221    -- * @statement@ is a serialization of a tag, @base@ and @basePowSec@,
 222    -- * @commitment '==' 'commit' proof base basePowSec '=='
 223    --   base '^' 'proof_response' '*' basePowSec '^' 'proof_challenge'@,
 224    -- * and @basePowSec '==' base'^'sec@,
 225    --
 226    -- then, with overwhelming probability (due to the 'hash' function),
 227    -- the prover was not able to choose 'proof_challenge'
 228    -- yet was able to compute a 'proof_response' such that
 229    -- (@commitment '==' base '^' 'proof_response' '*' basePowSec '^' 'proof_challenge'@),
 230    -- that is to say: @('proof_response' '==' logBase base 'commitment' '-' sec '*' 'proof_challenge')@,
 231    -- therefore the prover knows 'sec'.
 232    --
 233    -- The prover choses 'commitment' to be a random power of @base@,
 234    -- to ensure that each 'prove' does not reveal any information
 235    -- about its secret.
 236  }
 237 derive instance eqProof :: Eq (Proof crypto v c)
 238 instance showProof :: Show (Proof crypto v c) where
 239   show (Proof e) = show e
 240 instance encodeJsonProof ::
 241  ( Reifies v Version
 242  , CryptoParams crypto c
 243  ) => EncodeJson (Proof crypto v c) where
 244   encodeJson (Proof{proof_challenge, proof_response}) =
 245     "challenge" := proof_challenge ~>
 246     "response"  := proof_response ~>
 247     JSON.jsonEmptyObject
 248 instance decodeJsonProof ::
 249  ( Reifies v Version
 250  , CryptoParams crypto c
 251  ) => DecodeJson (Proof crypto v c) where
 252   decodeJson json = do
 253     obj <- decodeJson json
 254     proof_challenge <- obj .: "challenge"
 255     proof_response  <- obj .: "response"
 256     pure $ Proof{proof_challenge, proof_response}
 257
 258 -- ** Type 'ZKP'
 259 -- | Zero-knowledge proof.
 260 --
 261 -- A protocol is /zero-knowledge/ if the verifier
 262 -- learns nothing from the protocol except that the prover
 263 -- knows the secret.
 264 --
 265 -- DOC: Mihir Bellare and Phillip Rogaway. Random oracles are practical:
 266 --      A paradigm for designing efficient protocols. In ACM-CCS’93, 1993.
 267 newtype ZKP = ZKP String
 268
 269 -- ** Type 'Challenge'
 270 type Challenge = E
 271
 272 -- ** Type 'Oracle'
 273 -- An 'Oracle' returns the 'Challenge' of the 'Commitment's
 274 -- by 'hash'ing them (eventually with other 'Commitment's).
 275 --
 276 -- Used in 'prove' it enables a Fiat-Shamir transformation
 277 -- of an /interactive zero-knowledge/ (IZK) proof
 278 -- into a /non-interactive zero-knowledge/ (NIZK) proof.
 279 -- That is to say that the verifier does not have
 280 -- to send a 'Challenge' to the prover.
 281 -- Indeed, the prover now handles the 'Challenge'
 282 -- which becomes a (collision resistant) 'hash'
 283 -- of the prover's commitments (and statements to be a stronger proof).
 284 --
 285 -- NOTE: the returned 'Challenge' is within 'Effect' because in PureScript
 286 -- 'hash'ing needs this (due to the use of Node.Buffer).
 287 type Oracle list crypto c = list (Commitment crypto c) -> Effect (Challenge crypto c)
 288
 289 -- | @('prove' sec commitmentBases oracle)@
 290 -- returns a 'Proof' that @sec@ is known
 291 -- (by proving the knowledge of its discrete logarithm).
 292 --
 293 -- The 'Oracle' is given 'Commitment's equal to the 'commitmentBases'
 294 -- raised to the power of the secret nonce of the 'Proof',
 295 -- as those are the 'Commitment's that the verifier will obtain
 296 -- when composing the 'proof_challenge' and 'proof_response' together
 297 -- (with 'commit').
 298 --
 299 -- WARNING: for 'prove' to be a so-called /strong Fiat-Shamir transformation/ (not a weak):
 300 -- the statement must be included in the 'hash' (along with the commitments).
 301 --
 302 -- NOTE: a 'random' @nonce@ is used to ensure each 'prove'
 303 -- does not reveal any information regarding the secret @sec@,
 304 -- because two 'Proof's using the same 'Commitment'
 305 -- can be used to deduce @sec@ (using the special-soundness).
 306 prove ::
 307  forall crypto v c list.
 308  Reifies v Version =>
 309  CryptoParams crypto c =>
 310  Functor list =>
 311  E crypto c ->
 312  list (G crypto c) ->
 313  Oracle list crypto c ->
 314  Effect (Proof crypto v c)
 315 prove sec commitmentBases oracle = do
 316   nonce <- randomE
 317   let commitments = (_ ^ nonce) <$> commitmentBases
 318   proof_challenge <- oracle commitments
 319   pure $ Proof
 320    { proof_challenge
 321    , proof_response: nonce `op` (sec*proof_challenge)
 322    }
 323   where
 324   -- | See comments in 'commit'.
 325   op =
 326     if reflect (Proxy::Proxy v) `hasVersionTag` versionTagQuicker
 327     then (-)
 328     else (+)
 329
 330 -- | Like 'prove' but quicker. It chould replace 'prove' entirely
 331 -- when Helios-C specifications will be fixed.
 332 proveQuicker ::
 333  forall crypto v c list.
 334  Reifies v Version =>
 335  CryptoParams crypto c =>
 336  Functor list =>
 337  E crypto c ->
 338  list (G crypto c) ->
 339  Oracle list crypto c ->
 340  Effect (Proof crypto v c)
 341 proveQuicker sec commitmentBases oracle = do
 342   nonce <- randomE
 343   let commitments = (_ ^ nonce) <$> commitmentBases
 344   proof_challenge <- oracle commitments
 345   pure $ Proof
 346    { proof_challenge
 347    , proof_response: nonce - sec*proof_challenge
 348    }
 349
 350 -- | @('fakeProof')@ returns a 'Proof'
 351 -- whose 'proof_challenge' and 'proof_response' are uniformly chosen at random,
 352 -- instead of @('proof_challenge' '==' 'hash' statement commitments)@
 353 -- and @('proof_response' '==' nonce '+' sec '*' 'proof_challenge')@
 354 -- as a 'Proof' returned by 'prove'.
 355 --
 356 -- Used in 'proveEncryption' to fill the returned 'DisjProof'
 357 -- with fake 'Proof's for all 'Disjunction's but the encrypted one.
 358 fakeProof ::
 359  forall crypto v c.
 360  CryptoParams crypto c =>
 361  Effect (Proof crypto v c)
 362 fakeProof = do
 363   proof_challenge <- randomE
 364   proof_response  <- randomE
 365   pure $ Proof{proof_challenge, proof_response}
 366
 367 -- ** Type 'Commitment'
 368 -- | A commitment from the prover to the verifier.
 369 -- It's a power of 'groupGen' chosen randomly by the prover
 370 -- when making a 'Proof' with 'prove'.
 371 type Commitment = G
 372
 373 -- | @('commit' proof base basePowSec)@ returns a 'Commitment'
 374 -- from the given 'Proof' with the knowledge of the verifier.
 375 commit ::
 376  forall crypto v c.
 377  Reifies v Version =>
 378  CryptoParams crypto c =>
 379  Proof crypto v c ->
 380  G crypto c ->
 381  G crypto c ->
 382  Commitment crypto c
 383 commit (Proof p) base basePowSec =
 384   (base^p.proof_response) `op`
 385   (basePowSec^p.proof_challenge)
 386   where
 387   op =
 388     if reflect (Proxy::Proxy v) `hasVersionTag` versionTagQuicker
 389     then (*)
 390     else (/)
 391   -- TODO: contrary to some textbook presentations,
 392   -- @('*')@ should be used instead of @('/')@ to avoid the performance cost
 393   -- of a modular exponentiation @('^' ('groupOrder' '-' 'one'))@,
 394   -- this is compensated by using @('-')@ instead of @('+')@ in 'prove'.
 395
 396 -- | Like 'commit' but quicker. It chould replace 'commit' entirely
 397 -- when Helios-C specifications will be fixed.
 398 commitQuicker ::
 399  forall crypto v c.
 400  CryptoParams crypto c =>
 401  Proof crypto v c ->
 402  G crypto c ->
 403  G crypto c ->
 404  Commitment crypto c
 405 commitQuicker (Proof p) base basePowSec =
 406   base^p.proof_response *
 407   basePowSec^p.proof_challenge
 408
 409 -- * Type 'Disjunction'
 410 -- | A 'Disjunction' is an 'inverse'd @('groupGen' '^'opinion)@
 411 -- it's used in 'proveEncryption' to generate a 'Proof'
 412 -- that an 'encryption_vault' contains a given @('groupGen' '^'opinion)@,
 413 type Disjunction = G
 414
 415 booleanDisjunctions :: forall crypto c.  CryptoParams crypto c => LL.List (Disjunction crypto c)
 416 booleanDisjunctions = LL.take 2 $ groupGenInverses::LL.List (G crypto c)
 417
 418 intervalDisjunctions ::
 419  forall crypto c.
 420  CryptoParams crypto c =>
 421  Natural -> Natural -> LL.List (Disjunction crypto c)
 422 intervalDisjunctions mini maxi =
 423   LL.take (int $ (unwrap (nat maxi) + one)-unwrap (nat mini)) $
 424   LL.drop (int $ unwrap (nat mini)) $
 425   groupGenInverses :: LL.List (G crypto c)
 426   where
 427   int = Int.round <<< BigInt.toNumber
 428
 429 -- ** Type 'DisjProof'
 430 -- | A list of 'Proof's to prove that the opinion within an 'Encryption'
 431 -- is indexing a 'Disjunction' within a list of them,
 432 -- without revealing which opinion it is.
 433 newtype DisjProof crypto v c = DisjProof (List (Proof crypto v c))
 434 derive newtype instance eqDisjProof :: Eq (DisjProof crypto v c)
 435 derive newtype instance showDisjProof :: Show (DisjProof crypto v c)
 436 derive newtype instance encodeJsonDisjProof :: (Reifies v Version, CryptoParams crypto c) => EncodeJson (DisjProof crypto v c)
 437 derive newtype instance decodeJsonDisjProof :: (Reifies v Version, CryptoParams crypto c) => DecodeJson (DisjProof crypto v c)
 438 instance newtypeDisjProof :: Newtype (DisjProof crypto v c) (List (Proof crypto v c)) where
 439   wrap = DisjProof
 440   unwrap (DisjProof x) = x
 441
 442 -- | @('proveEncryption' elecPubKey voterZKP (prevDisjs,nextDisjs) (encNonce,enc))@
 443 -- returns a 'DisjProof' that 'enc' 'encrypt's
 444 -- the 'Disjunction' 'd' between 'prevDisjs' and 'nextDisjs'.
 445 --
 446 -- The prover proves that it knows an 'encNonce', such that:
 447 -- @(enc '==' Encryption{encryption_nonce='groupGen' '^'encNonce, encryption_vault=elecPubKey'^'encNonce '*' groupGen'^'d})@
 448 --
 449 -- A /NIZK Disjunctive Chaum Pedersen Logarithm Equality/ is used.
 450 --
 451 -- DOC: Pierrick Gaudry. <https://hal.inria.fr/hal-01576379 Some ZK security proofs for Belenios>, 2017.
 452 proveEncryption ::
 453  forall crypto v c.
 454  Reifies v Version =>
 455  CryptoParams crypto c =>
 456  PublicKey crypto c -> ZKP ->
 457  Tuple (List (Disjunction crypto c)) (List (Disjunction crypto c)) ->
 458  Tuple (EncryptionNonce crypto c) (Encryption crypto v c) ->
 459  Effect (DisjProof crypto v c)
 460 proveEncryption elecPubKey voterZKP (Tuple prevDisjs nextDisjs) (Tuple encNonce enc) = do
 461   -- Fake proofs for all 'Disjunction's except the genuine one.
 462   prevFakeProofs <- replicateA (List.length prevDisjs) fakeProof
 463   nextFakeProofs <- replicateA (List.length nextDisjs) fakeProof
 464   let fakeChallengeSum = sum ((\(Proof p) -> p.proof_challenge) <$> prevFakeProofs) +
 465                          sum ((\(Proof p) -> p.proof_challenge) <$> nextFakeProofs)
 466   let statement = encryptionStatement voterZKP enc
 467   genuineProof <- prove encNonce (groupGen : elecPubKey : List.Nil) $ \genuineCommitments -> do
 468     let validCommitments = List.zipWith (encryptionCommitments elecPubKey enc)
 469     let prevCommitments = validCommitments prevDisjs prevFakeProofs
 470     let nextCommitments = validCommitments nextDisjs nextFakeProofs
 471     let commitments = join prevCommitments <> genuineCommitments <> join nextCommitments
 472     challenge <- hash statement commitments
 473     let genuineChallenge = challenge - fakeChallengeSum
 474     pure genuineChallenge
 475     -- NOTE: here by construction (genuineChallenge == challenge - fakeChallengeSum)
 476     -- thus (sum ((\(Proof p) -> p.proof_challenge) <$> proofs) == challenge)
 477     -- as checked in 'verifyEncryption'.
 478   let proofs = prevFakeProofs <> (genuineProof : nextFakeProofs)
 479   pure (DisjProof proofs)
 480
 481 verifyEncryption ::
 482  forall crypto v c.
 483  Reifies v Version =>
 484  CryptoParams crypto c =>
 485  PublicKey crypto c -> ZKP ->
 486  List (Disjunction crypto c) -> Tuple (Encryption crypto v c) (DisjProof crypto v c) ->
 487  ExceptT ErrorVerifyEncryption Effect Boolean
 488 verifyEncryption elecPubKey voterZKP disjs (Tuple enc (DisjProof proofs)) =
 489   case isoZipWith (encryptionCommitments elecPubKey enc) disjs proofs of
 490    Nothing ->
 491     throwError $ ErrorVerifyEncryption_InvalidProofLength
 492      (nat $ List.length proofs)
 493      (nat $ List.length disjs)
 494    Just commitments -> do
 495     h <- lift $ hash (encryptionStatement voterZKP enc) (join commitments)
 496     pure (challengeSum == h)
 497   where
 498   challengeSum = sum ((\(Proof p) -> p.proof_challenge) <$> proofs)
 499
 500 -- ** Hashing
 501 encryptionStatement ::
 502  forall crypto v c.
 503  CryptoParams crypto c =>
 504  ZKP -> Encryption crypto v c -> String
 505 encryptionStatement (ZKP voterZKP) (Encryption enc) =
 506   "prove|"<>voterZKP<>"|"
 507    <> bytesNat enc.encryption_nonce<>","
 508    <> bytesNat enc.encryption_vault<>"|"
 509
 510 -- | @('encryptionCommitments' elecPubKey enc disj proof)@
 511 -- returns the 'Commitment's with only the knowledge of the verifier.
 512 --
 513 -- For the prover the 'Proof' comes from @fakeProof@,
 514 -- and for the verifier the 'Proof' comes from the prover.
 515 encryptionCommitments ::
 516  forall crypto v c.
 517  Reifies v Version =>
 518  CryptoParams crypto c =>
 519  PublicKey crypto c -> Encryption crypto v c ->
 520  Disjunction crypto c -> Proof crypto v c -> List (G crypto c)
 521 encryptionCommitments elecPubKey (Encryption enc) disj proof =
 522   commit proof groupGen enc.encryption_nonce :
 523     -- == groupGen ^ nonce if 'Proof' comes from 'prove'.
 524     -- base==groupGen, basePowSec==groupGen^encNonce.
 525   commit proof elecPubKey (enc.encryption_vault*disj) :
 526     -- == elecPubKey ^ nonce if 'Proof' comes from 'prove'
 527     -- and 'encryption_vault' encrypts (- logBase groupGen disj).
 528     -- base==elecPubKey, basePowSec==elecPubKey^encNonce.
 529   List.Nil
 530
 531 -- ** Type 'ErrorVerifyEncryption'
 532 -- | Error raised by 'verifyEncryption'.
 533 data ErrorVerifyEncryption
 534  =   ErrorVerifyEncryption_InvalidProofLength Natural Natural
 535      -- ^ When the number of proofs is different than
 536      -- the number of 'Disjunction's.
 537  -- deriving (Eq,Show)
 538
 539 -- * Type 'Signature'
 540 -- | Schnorr-like signature.
 541 --
 542 -- Used by each voter to sign his/her encrypted 'Ballot'
 543 -- using his/her 'Credential',
 544 -- in order to avoid ballot stuffing.
 545 data Signature crypto v c = Signature
 546  { signature_publicKey :: PublicKey crypto c
 547    -- ^ Verification key.
 548  , signature_proof     :: Proof crypto v c
 549  }
 550 instance encodeJsonSignature ::
 551  ( Reifies v Version
 552  , CryptoParams crypto c
 553  ) => EncodeJson (Signature crypto v c) where
 554   encodeJson (Signature{signature_publicKey:pubKey, signature_proof:Proof p}) =
 555     "public_key" := pubKey ~>
 556     "challenge" := p.proof_challenge ~>
 557     "response" := p.proof_response ~>
 558     JSON.jsonEmptyObject
 559 instance decodeJsonSignature ::
 560  ( Reifies v Version
 561  , CryptoParams crypto c
 562  ) => DecodeJson (Signature crypto v c) where
 563   decodeJson json = do
 564     obj <- decodeJson json
 565     signature_publicKey <- obj .: "public_key"
 566     proof_challenge <- obj .: "challenge"
 567     proof_response  <- obj .: "response"
 568     let signature_proof = Proof{proof_challenge, proof_response}
 569     pure $ Signature{signature_publicKey, signature_proof}