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