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

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