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