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