hjugement-protocol/src/Voting/Protocol/Cryptography.hs

   1 {-# LANGUAGE DataKinds #-}
   2 {-# LANGUAGE PolyKinds #-}
   3 {-# LANGUAGE DeriveAnyClass #-}
   4 {-# LANGUAGE DeriveGeneric #-}
   5 {-# LANGUAGE DerivingStrategies #-}
   6 {-# LANGUAGE OverloadedStrings #-}
   7 {-# LANGUAGE UndecidableInstances #-} -- for Reifies constraints in instances
   8 module Voting.Protocol.Cryptography where
   9
  10 import Control.DeepSeq (NFData)
  11 import Control.Monad (Monad(..), join, replicateM)
  12 import Control.Monad.Trans.Except (ExceptT(..), throwE)
  13 import Data.Aeson (ToJSON(..), FromJSON(..), (.:), (.=))
  14 import Data.Bits
  15 import Data.Bool
  16 import Data.Eq (Eq(..))
  17 import Data.Function (($), (.))
  18 import Data.Functor (Functor, (<$>))
  19 import Data.Maybe (Maybe(..), fromJust)
  20 import Data.Ord (Ord(..))
  21 import Data.Proxy (Proxy(..))
  22 import Data.Reflection (Reifies(..))
  23 import Data.Semigroup (Semigroup(..))
  24 import Data.String (IsString(..))
  25 import Data.Text (Text)
  26 import GHC.Generics (Generic)
  27 import GHC.Natural (minusNaturalMaybe)
  28 import Numeric.Natural (Natural)
  29 import Prelude (Bounded(..), fromIntegral)
  30 import System.Random (RandomGen)
  31 import Text.Show (Show(..))
  32 import qualified Control.Monad.Trans.State.Strict as S
  33 import qualified Crypto.Hash as Crypto
  34 import qualified Data.Aeson as JSON
  35 import qualified Data.ByteArray as ByteArray
  36 import qualified Data.ByteString as BS
  37 import qualified Data.ByteString.Base64 as BS64
  38 import qualified Data.List as List
  39 import qualified Data.Text as Text
  40 import qualified Data.Text.Encoding as Text
  41 import qualified Data.Text.Lazy as TL
  42 import qualified Data.Text.Lazy.Builder as TLB
  43 import qualified Data.Text.Lazy.Builder.Int as TLB
  44 import qualified System.Random as Random
  45
  46 import Voting.Protocol.Utils
  47 import Voting.Protocol.Arithmetic
  48 import Voting.Protocol.Version
  49
  50 -- * Type 'PublicKey'
  51 type PublicKey = G
  52 -- * Type 'SecretKey'
  53 type SecretKey = E
  54
  55 -- * Type 'Hash'
  56 newtype Hash crypto c = Hash (E crypto c)
  57  deriving newtype (Eq,Ord,Show,NFData)
  58
  59 -- | @('hash' bs gs)@ returns as a number in 'E'
  60 -- the 'Crypto.SHA256' hash of the given 'BS.ByteString' 'bs'
  61 -- prefixing the decimal representation of given subgroup elements 'gs',
  62 -- with a comma (",") intercalated between them.
  63 --
  64 -- NOTE: to avoid any collision when the 'hash' function is used in different contexts,
  65 -- a message 'gs' is actually prefixed by a 'bs' indicating the context.
  66 --
  67 -- Used by 'proveEncryption' and 'verifyEncryption',
  68 -- where the 'bs' usually contains the 'statement' to be proven,
  69 -- and the 'gs' contains the 'commitments'.
  70 hash :: CryptoParams crypto c => BS.ByteString -> [G crypto c] -> E crypto c
  71 hash bs gs = do
  72         let s = bs <> BS.intercalate (fromString ",") (bytesNat <$> gs)
  73         let h = Crypto.hashWith Crypto.SHA256 s
  74         fromNatural $
  75                 decodeBigEndian $ ByteArray.convert h
  76
  77 -- | @('decodeBigEndian' bs)@ interpret @bs@ as big-endian number.
  78 decodeBigEndian :: BS.ByteString -> Natural
  79 decodeBigEndian =
  80         BS.foldl'
  81          (\acc b -> acc`shiftL`8 + fromIntegral b)
  82          (0::Natural)
  83
  84 -- ** Type 'Base64SHA256'
  85 newtype Base64SHA256 = Base64SHA256 Text
  86  deriving (Eq,Ord,Show,Generic)
  87  deriving anyclass (ToJSON,FromJSON)
  88  deriving newtype NFData
  89
  90 -- | @('base64SHA256' bs)@ returns the 'Crypto.SHA256' hash
  91 -- of the given 'BS.ByteString' 'bs',
  92 -- as a 'Text' escaped in @base64@ encoding
  93 -- (<https://tools.ietf.org/html/rfc4648 RFC 4648>).
  94 base64SHA256 :: BS.ByteString -> Base64SHA256
  95 base64SHA256 bs =
  96         let h = Crypto.hashWith Crypto.SHA256 bs in
  97         Base64SHA256 $
  98                 Text.takeWhile (/= '=') $ -- NOTE: no padding.
  99                 Text.decodeUtf8 $ BS64.encode $ ByteArray.convert h
 100
 101 -- ** Type 'HexSHA256'
 102 newtype HexSHA256 = HexSHA256 Text
 103  deriving (Eq,Ord,Show,Generic)
 104  deriving anyclass (ToJSON,FromJSON)
 105  deriving newtype NFData
 106 -- | @('hexSHA256' bs)@ returns the 'Crypto.SHA256' hash
 107 -- of the given 'BS.ByteString' 'bs', escaped in hexadecimal
 108 -- into a 'Text' of 32 lowercase characters.
 109 --
 110 -- Used (in retro-dependencies of this library) to hash
 111 -- the 'PublicKey' of a voter or a trustee.
 112 hexSHA256 :: BS.ByteString -> Text
 113 hexSHA256 bs =
 114         let h = Crypto.hashWith Crypto.SHA256 bs in
 115         let n = decodeBigEndian $ ByteArray.convert h in
 116         -- NOTE: always set the 256 bit then remove it
 117         -- to always have leading zeros,
 118         -- and thus always 64 characters wide hashes.
 119         TL.toStrict $
 120         TL.tail $ TLB.toLazyText $ TLB.hexadecimal $
 121         setBit n 256
 122
 123 -- * Random
 124
 125 -- | @('randomR' i)@ returns a random integer in @[0..i-1]@.
 126 randomR ::
 127  Monad m =>
 128  Random.RandomGen r =>
 129  Random.Random i =>
 130  Ring i =>
 131  i -> S.StateT r m i
 132 randomR i = S.StateT $ return . Random.randomR (zero, i-one)
 133
 134 -- | @('random')@ returns a random integer
 135 -- in the range determined by its type.
 136 random ::
 137  Monad m =>
 138  Random.RandomGen r =>
 139  Random.Random i =>
 140  Bounded i =>
 141  S.StateT r m i
 142 random = S.StateT $ return . Random.random
 143
 144 -- * Type 'Encryption'
 145 -- | ElGamal-like encryption.
 146 -- Its security relies on the /Discrete Logarithm problem/.
 147 --
 148 -- Because ('groupGen' '^'encNonce '^'secKey '==' 'groupGen' '^'secKey '^'encNonce),
 149 -- knowing @secKey@, one can divide 'encryption_vault' by @('encryption_nonce' '^'secKey)@
 150 -- to decipher @('groupGen' '^'clear)@, then the @clear@ text must be small to be decryptable,
 151 -- because it is encrypted as a power of 'groupGen' (hence the "-like" in "ElGamal-like")
 152 -- to enable the additive homomorphism.
 153 --
 154 -- NOTE: Since @('encryption_vault' '*' 'encryption_nonce' '==' 'encryption_nonce' '^' (secKey '+' clear))@,
 155 -- then: @(logBase 'encryption_nonce' ('encryption_vault' '*' 'encryption_nonce') '==' secKey '+' clear)@.
 156 data Encryption crypto v c = Encryption
 157  { encryption_nonce :: !(G crypto c)
 158    -- ^ Public part of the randomness 'encNonce' used to 'encrypt' the 'clear' text,
 159    -- equal to @('groupGen' '^'encNonce)@
 160  , encryption_vault :: !(G crypto c)
 161    -- ^ Encrypted 'clear' text,
 162    -- equal to @('pubKey' '^'encNone '*' 'groupGen' '^'clear)@
 163  } deriving (Generic)
 164 deriving instance Eq (G crypto c) => Eq (Encryption crypto v c)
 165 deriving instance (Show (G crypto c), Show (G crypto c)) => Show (Encryption crypto v c)
 166 deriving instance NFData (G crypto c) => NFData (Encryption crypto v c)
 167 instance
 168  ( Reifies v Version
 169  , CryptoParams crypto c
 170  ) => ToJSON (Encryption crypto v c) where
 171         toJSON Encryption{..} =
 172                 JSON.object
 173                  [ "alpha" .= encryption_nonce
 174                  , "beta"  .= encryption_vault
 175                  ]
 176         toEncoding Encryption{..} =
 177                 JSON.pairs
 178                  (  "alpha" .= encryption_nonce
 179                  <> "beta"  .= encryption_vault
 180                  )
 181 instance
 182  ( Reifies v Version
 183  , CryptoParams crypto c
 184  ) => FromJSON (Encryption crypto v c) where
 185         parseJSON = JSON.withObject "Encryption" $ \o -> do
 186                 encryption_nonce <- o .: "alpha"
 187                 encryption_vault <- o .: "beta"
 188                 return Encryption{..}
 189
 190 -- | Additive homomorphism.
 191 -- Using the fact that: @'groupGen' '^'x '*' 'groupGen' '^'y '==' 'groupGen' '^'(x'+'y)@.
 192 instance CryptoParams crypto c => Additive (Encryption crypto v c) where
 193         zero = Encryption one one
 194         x+y = Encryption
 195          (encryption_nonce x * encryption_nonce y)
 196          (encryption_vault x * encryption_vault y)
 197
 198 -- *** Type 'EncryptionNonce'
 199 type EncryptionNonce = E
 200
 201 -- | @('encrypt' pubKey clear)@ returns an ElGamal-like 'Encryption'.
 202 --
 203 -- WARNING: the secret encryption nonce (@encNonce@)
 204 -- is returned alongside the 'Encryption'
 205 -- in order to 'prove' the validity of the encrypted 'clear' text in 'proveEncryption',
 206 -- but this secret @encNonce@ MUST be forgotten after that,
 207 -- as it may be used to decipher the 'Encryption'
 208 -- without the 'SecretKey' associated with 'pubKey'.
 209 encrypt ::
 210  Reifies v Version =>
 211  CryptoParams crypto c =>
 212  Monad m => RandomGen r =>
 213  PublicKey crypto c -> E crypto c ->
 214  S.StateT r m (EncryptionNonce crypto c, Encryption crypto v c)
 215 encrypt pubKey clear = do
 216         encNonce <- random
 217         -- NOTE: preserve the 'encNonce' for 'prove' in 'proveEncryption'.
 218         return $ (encNonce,)
 219                 Encryption
 220                  { encryption_nonce = groupGen^encNonce
 221                  , encryption_vault = pubKey  ^encNonce * groupGen^clear
 222                  }
 223
 224 -- * Type 'Proof'
 225 -- | Non-Interactive Zero-Knowledge 'Proof'
 226 -- of knowledge of a discrete logarithm:
 227 -- @(secret == logBase base (base^secret))@.
 228 data Proof crypto v c = Proof
 229  { proof_challenge :: !(Challenge crypto c)
 230    -- ^ 'Challenge' sent by the verifier to the prover
 231    -- to ensure that the prover really has knowledge
 232    -- of the secret and is not replaying.
 233    -- Actually, 'proof_challenge' is not sent to the prover,
 234    -- but derived from the prover's 'Commitment's and statements
 235    -- with a collision resistant 'hash'.
 236    -- Hence the prover cannot chose the 'proof_challenge' to his/her liking.
 237  , proof_response :: !(E crypto c)
 238    -- ^ A discrete logarithm sent by the prover to the verifier,
 239    -- as a response to 'proof_challenge'.
 240    --
 241    -- If the verifier observes that @('proof_challenge' '==' 'hash' statement [commitment])@, where:
 242    --
 243    -- * @statement@ is a serialization of a tag, @base@ and @basePowSec@,
 244    -- * @commitment '==' 'commit' proof base basePowSec '=='
 245    --   base '^' 'proof_response' '*' basePowSec '^' 'proof_challenge'@,
 246    -- * and @basePowSec '==' base'^'sec@,
 247    --
 248    -- then, with overwhelming probability (due to the 'hash' function),
 249    -- the prover was not able to choose 'proof_challenge'
 250    -- yet was able to compute a 'proof_response' such that
 251    -- (@commitment '==' base '^' 'proof_response' '*' basePowSec '^' 'proof_challenge'@),
 252    -- that is to say: @('proof_response' '==' logBase base 'commitment' '-' sec '*' 'proof_challenge')@,
 253    -- therefore the prover knows 'sec'.
 254    --
 255    -- The prover choses 'commitment' to be a random power of @base@,
 256    -- to ensure that each 'prove' does not reveal any information
 257    -- about its secret.
 258  } deriving (Eq,Show,NFData,Generic)
 259 instance Reifies v Version => ToJSON (Proof crypto v c) where
 260         toJSON Proof{..} =
 261                 JSON.object
 262                  [ "challenge" .= proof_challenge
 263                  , "response"  .= proof_response
 264                  ]
 265         toEncoding Proof{..} =
 266                 JSON.pairs
 267                  (  "challenge" .= proof_challenge
 268                  <> "response"  .= proof_response
 269                  )
 270 instance
 271  ( CryptoParams crypto c
 272  , Reifies v Version
 273  ) => FromJSON (Proof crypto v c) where
 274         parseJSON = JSON.withObject "Proof" $ \o -> do
 275                 proof_challenge <- o .: "challenge"
 276                 proof_response  <- o .: "response"
 277                 return Proof{..}
 278
 279 -- ** Type 'ZKP'
 280 -- | Zero-knowledge proof.
 281 --
 282 -- A protocol is /zero-knowledge/ if the verifier
 283 -- learns nothing from the protocol except that the prover
 284 -- knows the secret.
 285 --
 286 -- DOC: Mihir Bellare and Phillip Rogaway. Random oracles are practical:
 287 --      A paradigm for designing efficient protocols. In ACM-CCS’93, 1993.
 288 newtype ZKP = ZKP BS.ByteString
 289
 290 -- ** Type 'Challenge'
 291 type Challenge = E
 292
 293 -- ** Type 'Oracle'
 294 -- An 'Oracle' returns the 'Challenge' of the 'Commitment's
 295 -- by 'hash'ing them (eventually with other 'Commitment's).
 296 --
 297 -- Used in 'prove' it enables a Fiat-Shamir transformation
 298 -- of an /interactive zero-knowledge/ (IZK) proof
 299 -- into a /non-interactive zero-knowledge/ (NIZK) proof.
 300 -- That is to say that the verifier does not have
 301 -- to send a 'Challenge' to the prover.
 302 -- Indeed, the prover now handles the 'Challenge'
 303 -- which becomes a (collision resistant) 'hash'
 304 -- of the prover's commitments (and statements to be a stronger proof).
 305 type Oracle list crypto c = list (Commitment crypto c) -> Challenge crypto c
 306
 307 -- | @('prove' sec commitmentBases oracle)@
 308 -- returns a 'Proof' that @sec@ is known
 309 -- (by proving the knowledge of its discrete logarithm).
 310 --
 311 -- The 'Oracle' is given 'Commitment's equal to the 'commitmentBases'
 312 -- raised to the power of the secret nonce of the 'Proof',
 313 -- as those are the 'Commitment's that the verifier will obtain
 314 -- when composing the 'proof_challenge' and 'proof_response' together
 315 -- (with 'commit').
 316 --
 317 -- WARNING: for 'prove' to be a so-called /strong Fiat-Shamir transformation/ (not a weak):
 318 -- the statement must be included in the 'hash' (along with the commitments).
 319 --
 320 -- NOTE: a 'random' @nonce@ is used to ensure each 'prove'
 321 -- does not reveal any information regarding the secret @sec@,
 322 -- because two 'Proof's using the same 'Commitment'
 323 -- can be used to deduce @sec@ (using the special-soundness).
 324 prove ::
 325  forall crypto v c list m r.
 326  Reifies v Version =>
 327  CryptoParams crypto c =>
 328  Monad m => RandomGen r => Functor list =>
 329  E crypto c ->
 330  list (G crypto c) ->
 331  Oracle list crypto c ->
 332  S.StateT r m (Proof crypto v c)
 333 prove sec commitmentBases oracle = do
 334         nonce <- random
 335         let commitments = (^ nonce) <$> commitmentBases
 336         let proof_challenge = oracle commitments
 337         return Proof
 338          { proof_challenge
 339          , proof_response = nonce `op` (sec*proof_challenge)
 340          }
 341         where
 342         -- | See comments in 'commit'.
 343         op =
 344                 if reflect (Proxy @v) `hasVersionTag` versionTagQuicker
 345                 then (-)
 346                 else (+)
 347
 348 -- | Like 'prove' but quicker. It chould replace 'prove' entirely
 349 -- when Helios-C specifications will be fixed.
 350 proveQuicker ::
 351  Reifies v Version =>
 352  CryptoParams crypto c =>
 353  Monad m => RandomGen r => Functor list =>
 354  E crypto c ->
 355  list (G crypto c) ->
 356  Oracle list crypto c ->
 357  S.StateT r m (Proof crypto v c)
 358 proveQuicker sec commitmentBases oracle = do
 359         nonce <- random
 360         let commitments = (^ nonce) <$> commitmentBases
 361         let proof_challenge = oracle commitments
 362         return Proof
 363          { proof_challenge
 364          , proof_response = nonce - sec*proof_challenge
 365          }
 366
 367 -- | @('fakeProof')@ returns a 'Proof'
 368 -- whose 'proof_challenge' and 'proof_response' are uniformly chosen at random,
 369 -- instead of @('proof_challenge' '==' 'hash' statement commitments)@
 370 -- and @('proof_response' '==' nonce '+' sec '*' 'proof_challenge')@
 371 -- as a 'Proof' returned by 'prove'.
 372 --
 373 -- Used in 'proveEncryption' to fill the returned 'DisjProof'
 374 -- with fake 'Proof's for all 'Disjunction's but the encrypted one.
 375 fakeProof ::
 376  CryptoParams crypto c =>
 377  Monad m => RandomGen r =>
 378  S.StateT r m (Proof crypto v c)
 379 fakeProof = do
 380         proof_challenge <- random
 381         proof_response  <- random
 382         return Proof{..}
 383
 384 -- ** Type 'Commitment'
 385 -- | A commitment from the prover to the verifier.
 386 -- It's a power of 'groupGen' chosen randomly by the prover
 387 -- when making a 'Proof' with 'prove'.
 388 type Commitment = G
 389
 390 -- | @('commit' proof base basePowSec)@ returns a 'Commitment'
 391 -- from the given 'Proof' with the knowledge of the verifier.
 392 commit ::
 393  forall crypto v c.
 394  Reifies v Version =>
 395  CryptoParams crypto c =>
 396  Proof crypto v c ->
 397  G crypto c ->
 398  G crypto c ->
 399  Commitment crypto c
 400 commit Proof{..} base basePowSec =
 401         (base^proof_response) `op`
 402         (basePowSec^proof_challenge)
 403         where
 404         op =
 405                 if reflect (Proxy @v) `hasVersionTag` versionTagQuicker
 406                 then (*)
 407                 else (/)
 408   -- TODO: contrary to some textbook presentations,
 409   -- @('*')@ should be used instead of @('/')@ to avoid the performance cost
 410   -- of a modular exponentiation @('^' ('groupOrder' '-' 'one'))@,
 411   -- this is compensated by using @('-')@ instead of @('+')@ in 'prove'.
 412 {-# INLINE commit #-}
 413
 414 -- | Like 'commit' but quicker. It chould replace 'commit' entirely
 415 -- when Helios-C specifications will be fixed.
 416 commitQuicker ::
 417  CryptoParams crypto c =>
 418  Proof crypto v c ->
 419  G crypto c ->
 420  G crypto c ->
 421  Commitment crypto c
 422 commitQuicker Proof{..} base basePowSec =
 423         base^proof_response *
 424         basePowSec^proof_challenge
 425
 426 -- * Type 'Disjunction'
 427 -- | A 'Disjunction' is an 'inverse'd @('groupGen' '^'opinion)@
 428 -- it's used in 'proveEncryption' to generate a 'Proof'
 429 -- that an 'encryption_vault' contains a given @('groupGen' '^'opinion)@,
 430 type Disjunction = G
 431
 432 booleanDisjunctions ::
 433  forall crypto c.
 434  CryptoParams crypto c =>
 435  [Disjunction crypto c]
 436 booleanDisjunctions = List.take 2 $ groupGenInverses @crypto
 437
 438 intervalDisjunctions ::
 439  forall crypto c.
 440  CryptoParams crypto c =>
 441  Natural -> Natural -> [Disjunction crypto c]
 442 intervalDisjunctions mini maxi =
 443         List.genericTake (fromJust $ (nat maxi + 1)`minusNaturalMaybe`nat mini) $
 444         List.genericDrop (nat mini) $
 445         groupGenInverses @crypto
 446
 447 -- ** Type 'DisjProof'
 448 -- | A list of 'Proof's to prove that the opinion within an 'Encryption'
 449 -- is indexing a 'Disjunction' within a list of them,
 450 -- without revealing which opinion it is.
 451 newtype DisjProof crypto v c = DisjProof [Proof crypto v c]
 452  deriving (Eq,Show,Generic)
 453  deriving newtype (NFData)
 454 deriving newtype instance Reifies v Version => ToJSON (DisjProof crypto v c)
 455 deriving newtype instance (Reifies v Version, CryptoParams crypto c) => FromJSON (DisjProof crypto v c)
 456
 457 -- | @('proveEncryption' elecPubKey voterZKP (prevDisjs,nextDisjs) (encNonce,enc))@
 458 -- returns a 'DisjProof' that 'enc' 'encrypt's
 459 -- the 'Disjunction' 'd' between 'prevDisjs' and 'nextDisjs'.
 460 --
 461 -- The prover proves that it knows an 'encNonce', such that:
 462 -- @(enc '==' Encryption{encryption_nonce='groupGen' '^'encNonce, encryption_vault=elecPubKey'^'encNonce '*' groupGen'^'d})@
 463 --
 464 -- A /NIZK Disjunctive Chaum Pedersen Logarithm Equality/ is used.
 465 --
 466 -- DOC: Pierrick Gaudry. <https://hal.inria.fr/hal-01576379 Some ZK security proofs for Belenios>, 2017.
 467 proveEncryption ::
 468  Reifies v Version =>
 469  CryptoParams crypto c =>
 470  Monad m => RandomGen r =>
 471  PublicKey crypto c -> ZKP ->
 472  ([Disjunction crypto c],[Disjunction crypto c]) ->
 473  (EncryptionNonce crypto c, Encryption crypto v c) ->
 474  S.StateT r m (DisjProof crypto v c)
 475 proveEncryption elecPubKey voterZKP (prevDisjs,nextDisjs) (encNonce,enc) = do
 476         -- Fake proofs for all 'Disjunction's except the genuine one.
 477         prevFakeProofs <- replicateM (List.length prevDisjs) fakeProof
 478         nextFakeProofs <- replicateM (List.length nextDisjs) fakeProof
 479         let fakeChallengeSum =
 480                 sum (proof_challenge <$> prevFakeProofs) +
 481                 sum (proof_challenge <$> nextFakeProofs)
 482         let statement = encryptionStatement voterZKP enc
 483         genuineProof <- prove encNonce [groupGen, elecPubKey] $ \genuineCommitments ->
 484                 let validCommitments = List.zipWith (encryptionCommitments elecPubKey enc) in
 485                 let prevCommitments = validCommitments prevDisjs prevFakeProofs in
 486                 let nextCommitments = validCommitments nextDisjs nextFakeProofs in
 487                 let commitments = join prevCommitments <> genuineCommitments <> join nextCommitments in
 488                 let challenge = hash statement commitments in
 489                 let genuineChallenge = challenge - fakeChallengeSum in
 490                 genuineChallenge
 491                 -- NOTE: here by construction (genuineChallenge == challenge - fakeChallengeSum)
 492                 -- thus (sum (proof_challenge <$> proofs) == challenge)
 493                 -- as checked in 'verifyEncryption'.
 494         let proofs = prevFakeProofs <> (genuineProof : nextFakeProofs)
 495         return (DisjProof proofs)
 496
 497 verifyEncryption ::
 498  Reifies v Version =>
 499  CryptoParams crypto c =>
 500  Monad m =>
 501  PublicKey crypto c -> ZKP ->
 502  [Disjunction crypto c] -> (Encryption crypto v c, DisjProof crypto v c) ->
 503  ExceptT ErrorVerifyEncryption m Bool
 504 verifyEncryption elecPubKey voterZKP disjs (enc, DisjProof proofs) =
 505         case isoZipWith (encryptionCommitments elecPubKey enc) disjs proofs of
 506          Nothing ->
 507                 throwE $ ErrorVerifyEncryption_InvalidProofLength
 508                  (fromIntegral $ List.length proofs)
 509                  (fromIntegral $ List.length disjs)
 510          Just commitments ->
 511                 return $ challengeSum ==
 512                         hash (encryptionStatement voterZKP enc) (join commitments)
 513         where
 514         challengeSum = sum (proof_challenge <$> proofs)
 515
 516 -- ** Hashing
 517 encryptionStatement ::
 518  CryptoParams crypto c =>
 519  ZKP -> Encryption crypto v c -> BS.ByteString
 520 encryptionStatement (ZKP voterZKP) Encryption{..} =
 521         "prove|"<>voterZKP<>"|"
 522          <> bytesNat encryption_nonce<>","
 523          <> bytesNat encryption_vault<>"|"
 524
 525 -- | @('encryptionCommitments' elecPubKey enc disj proof)@
 526 -- returns the 'Commitment's with only the knowledge of the verifier.
 527 --
 528 -- For the prover the 'Proof' comes from @fakeProof@,
 529 -- and for the verifier the 'Proof' comes from the prover.
 530 encryptionCommitments ::
 531  Reifies v Version =>
 532  CryptoParams crypto c =>
 533  PublicKey crypto c -> Encryption crypto v c ->
 534  Disjunction crypto c -> Proof crypto v c -> [G crypto c]
 535 encryptionCommitments elecPubKey Encryption{..} disj proof =
 536         [ commit proof groupGen encryption_nonce
 537           -- == groupGen ^ nonce if 'Proof' comes from 'prove'.
 538           -- base==groupGen, basePowSec==groupGen^encNonce.
 539         , commit proof elecPubKey (encryption_vault*disj)
 540           -- == elecPubKey ^ nonce if 'Proof' comes from 'prove'
 541           -- and 'encryption_vault' encrypts (- logBase groupGen disj).
 542           -- base==elecPubKey, basePowSec==elecPubKey^encNonce.
 543         ]
 544
 545 -- ** Type 'ErrorVerifyEncryption'
 546 -- | Error raised by 'verifyEncryption'.
 547 data ErrorVerifyEncryption
 548  =   ErrorVerifyEncryption_InvalidProofLength Natural Natural
 549      -- ^ When the number of proofs is different than
 550      -- the number of 'Disjunction's.
 551  deriving (Eq,Show)
 552
 553 -- * Type 'Signature'
 554 -- | Schnorr-like signature.
 555 --
 556 -- Used by each voter to sign his/her encrypted 'Ballot'
 557 -- using his/her 'Credential',
 558 -- in order to avoid ballot stuffing.
 559 data Signature crypto v c = Signature
 560  { signature_publicKey :: !(PublicKey crypto c)
 561    -- ^ Verification key.
 562  , signature_proof     :: !(Proof crypto v c)
 563  } deriving (Generic)
 564 deriving instance (NFData crypto, NFData (G crypto c)) => NFData (Signature crypto v c)
 565 instance
 566  ( Reifies v Version
 567  , CryptoParams crypto c
 568  ) => ToJSON (Signature crypto v c) where
 569         toJSON (Signature pubKey Proof{..}) =
 570                 JSON.object
 571                  [ "public_key" .= pubKey
 572                  , "challenge"  .= proof_challenge
 573                  , "response"   .= proof_response
 574                  ]
 575         toEncoding (Signature pubKey Proof{..}) =
 576                 JSON.pairs
 577                  (  "public_key" .= pubKey
 578                  <> "challenge"  .= proof_challenge
 579                  <> "response"   .= proof_response
 580                  )
 581 instance
 582  ( Reifies v Version
 583  , CryptoParams crypto c
 584  ) => FromJSON (Signature crypto v c) where
 585         parseJSON = JSON.withObject "Signature" $ \o -> do
 586                 signature_publicKey <- o .: "public_key"
 587                 proof_challenge     <- o .: "challenge"
 588                 proof_response      <- o .: "response"
 589                 let signature_proof = Proof{..}
 590                 return Signature{..}