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

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