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