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

   1 {-# LANGUAGE DeriveAnyClass #-}
   2 {-# LANGUAGE DeriveGeneric #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4 module Voting.Protocol.Tally where
   5
   6 import Control.DeepSeq (NFData)
   7 import Control.Monad (Monad(..), mapM, unless)
   8 import Control.Monad.Trans.Except (Except, ExceptT, throwE)
   9 import Data.Eq (Eq(..))
  10 import Data.Function (($))
  11 import Data.Functor ((<$>))
  12 import Data.Maybe (maybe)
  13 import Data.Semigroup (Semigroup(..))
  14 import Data.Tuple (fst)
  15 import GHC.Generics (Generic)
  16 import Numeric.Natural (Natural)
  17 import Prelude (fromIntegral)
  18 import Text.Show (Show(..))
  19 import qualified Control.Monad.Trans.State.Strict as S
  20 import qualified Data.ByteString as BS
  21 import qualified Data.List as List
  22 import qualified Data.Map.Strict as Map
  23
  24 import Voting.Protocol.Utils
  25 import Voting.Protocol.Arithmetic
  26 import Voting.Protocol.Credential
  27 import Voting.Protocol.Election
  28
  29 -- * Type 'Tally'
  30 data Tally q = Tally
  31  { tally_countMax :: Natural
  32    -- ^ The maximal number of supportive 'Opinion's that a choice can get,
  33    -- which is here the same as the number of 'Ballot's.
  34    --
  35    -- Used in 'proveTally' to decrypt the actual
  36    -- count of votes obtained by a choice,
  37    -- by precomputing all powers of 'groupGen's up to it.
  38  , tally_encByChoiceByQuest :: EncryptedTally q
  39    -- ^ 'Encryption' by 'Question' by 'Ballot'.
  40  , tally_decShareByTrustee :: [DecryptionShare q]
  41    -- ^ 'DecryptionShare' by trustee.
  42  , tally_countByChoiceByQuest :: [[Natural]]
  43    -- ^ The decrypted count of supportive 'Opinion's, by choice by 'Question'.
  44  } deriving (Eq,Show,Generic,NFData)
  45
  46 -- ** Type 'EncryptedTally'
  47 -- | 'Encryption' by choice by 'Question'.
  48 type EncryptedTally q = [[Encryption q]]
  49
  50 -- | @('encryptedTally' ballots)@
  51 -- returns the sum of the 'Encryption's of the given @ballots@,
  52 -- along with the number of 'Ballot's.
  53 encryptedTally :: SubGroup q => [Ballot q] -> (EncryptedTally q, Natural)
  54 encryptedTally ballots =
  55         ( List.foldr (\Ballot{..} ->
  56                 List.zipWith (\Answer{..} ->
  57                         List.zipWith (+)
  58                          (fst <$> answer_opinions))
  59                  ballot_answers)
  60          (List.repeat (List.repeat zero))
  61          ballots
  62         , fromIntegral $ List.length ballots
  63         )
  64
  65 -- ** Type 'DecryptionShareCombinator'
  66 type DecryptionShareCombinator q =
  67         EncryptedTally q -> [DecryptionShare q] -> Except ErrorTally [[DecryptionFactor q]]
  68
  69 proveTally ::
  70  SubGroup q =>
  71  (EncryptedTally q, Natural) -> [DecryptionShare q] ->
  72  DecryptionShareCombinator q ->
  73  Except ErrorTally (Tally q)
  74 proveTally
  75  (tally_encByChoiceByQuest, tally_countMax)
  76  tally_decShareByTrustee
  77  decShareCombinator = do
  78         decFactorByChoiceByQuest <- decShareCombinator tally_encByChoiceByQuest tally_decShareByTrustee
  79         dec <- isoZipWithM (throwE ErrorTally_NumberOfQuestions)
  80          (maybe (throwE ErrorTally_NumberOfChoices) return `o2`
  81                 isoZipWith (\Encryption{..} decFactor -> encryption_vault / decFactor))
  82          tally_encByChoiceByQuest
  83          decFactorByChoiceByQuest
  84         let logMap = Map.fromList $ List.zip groupGenPowers [0..tally_countMax]
  85         let log x =
  86                 maybe (throwE ErrorTally_CannotDecryptCount) return $
  87                 Map.lookup x logMap
  88         tally_countByChoiceByQuest <- (log `mapM`)`mapM`dec
  89         return Tally{..}
  90
  91 verifyTally ::
  92  SubGroup q =>
  93  Tally q -> DecryptionShareCombinator q ->
  94  Except ErrorTally ()
  95 verifyTally Tally{..} decShareCombinator = do
  96         decFactorByChoiceByQuest <- decShareCombinator tally_encByChoiceByQuest tally_decShareByTrustee
  97         isoZipWith3M_ (throwE ErrorTally_NumberOfQuestions)
  98          (isoZipWith3M_ (throwE ErrorTally_NumberOfChoices)
  99                  (\Encryption{..} decFactor count -> do
 100                         let groupGenPowCount = encryption_vault / decFactor
 101                         unless (groupGenPowCount == groupGen ^ fromNatural count) $
 102                                 throwE ErrorTally_WrongProof))
 103          tally_encByChoiceByQuest
 104          decFactorByChoiceByQuest
 105          tally_countByChoiceByQuest
 106
 107 -- ** Type 'DecryptionShare'
 108 -- | A decryption share is a 'DecryptionFactor' and a decryption 'Proof', by choice by 'Question'.
 109 -- Computed by a trustee in 'proveDecryptionShare'.
 110 type DecryptionShare q = [[(DecryptionFactor q, Proof q)]]
 111
 112 -- *** Type 'DecryptionFactor'
 113 -- | @'encryption_nonce' '^'trusteeSecKey@
 114 type DecryptionFactor = G
 115
 116 -- @('proveDecryptionShare' encByChoiceByQuest trusteeSecKey)@
 117 proveDecryptionShare ::
 118  Monad m => SubGroup q => RandomGen r =>
 119  EncryptedTally q -> SecretKey q -> S.StateT r m (DecryptionShare q)
 120 proveDecryptionShare encByChoiceByQuest trusteeSecKey =
 121         (proveDecryptionFactor trusteeSecKey `mapM`) `mapM` encByChoiceByQuest
 122
 123 proveDecryptionFactor ::
 124  Monad m => SubGroup q => RandomGen r =>
 125  SecretKey q -> Encryption q -> S.StateT r m (DecryptionFactor q, Proof q)
 126 proveDecryptionFactor trusteeSecKey Encryption{..} = do
 127         proof <- prove trusteeSecKey [groupGen, encryption_nonce] (hash zkp)
 128         return (encryption_nonce^trusteeSecKey, proof)
 129         where zkp = decryptionShareStatement (publicKey trusteeSecKey)
 130
 131 decryptionShareStatement :: SubGroup q => PublicKey q -> BS.ByteString
 132 decryptionShareStatement pubKey =
 133         "decrypt|"<>bytesNat pubKey<>"|"
 134
 135 -- *** Type 'ErrorTally'
 136 data ErrorTally
 137  =   ErrorTally_NumberOfQuestions
 138      -- ^ The number of 'Question's is not the one expected.
 139  |   ErrorTally_NumberOfChoices
 140      -- ^ The number of choices is not the one expected.
 141  |   ErrorTally_NumberOfTrustees
 142      -- ^ The number of trustees is not the one expected.
 143  |   ErrorTally_WrongProof
 144      -- ^ The 'Proof' of a 'DecryptionFactor' is wrong.
 145  |   ErrorTally_CannotDecryptCount
 146      -- ^ Raised by 'proveTally' when the discrete logarithm of @'groupGen' '^'count@
 147      -- cannot be computed, likely because 'tally_countMax' is wrong,
 148      -- or because the 'EncryptedTally' or 'DecryptionShare's have not been verified.
 149  deriving (Eq,Show,Generic,NFData)
 150
 151 -- | @('verifyDecryptionShare' encTally trusteePubKey trusteeDecShare)@
 152 -- checks that 'trusteeDecShare'
 153 -- (supposedly submitted by a trustee whose 'PublicKey' is 'trusteePubKey')
 154 -- is valid with respect to the 'EncryptedTally' 'encTally'.
 155 verifyDecryptionShare ::
 156  Monad m => SubGroup q =>
 157  EncryptedTally q -> PublicKey q -> DecryptionShare q ->
 158  ExceptT ErrorTally m ()
 159 verifyDecryptionShare encByChoiceByQuest trusteePubKey =
 160         let zkp = decryptionShareStatement trusteePubKey in
 161         isoZipWithM_ (throwE ErrorTally_NumberOfQuestions)
 162          (isoZipWithM_ (throwE ErrorTally_NumberOfChoices) $
 163          \Encryption{..} (decFactor, proof) ->
 164                 unless (proof_challenge proof == hash zkp
 165                  [ commit proof groupGen trusteePubKey
 166                  , commit proof encryption_nonce decFactor
 167                  ]) $ throwE ErrorTally_WrongProof)
 168          encByChoiceByQuest
 169
 170 verifyDecryptionShareByTrustee ::
 171  Monad m => SubGroup q =>
 172  EncryptedTally q -> [PublicKey q] -> [DecryptionShare q] ->
 173  ExceptT ErrorTally m ()
 174 verifyDecryptionShareByTrustee encTally =
 175         isoZipWithM_ (throwE ErrorTally_NumberOfTrustees)
 176          (verifyDecryptionShare encTally)