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