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