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 (FieldElement crypto c) => Eq (Tally crypto v c)
  54 deriving instance (Show (FieldElement crypto c), Show (G crypto c)) => Show (Tally crypto v c)
  55 deriving instance NFData (FieldElement crypto c) => NFData (Tally crypto v c)
  56 instance
  57  ( Reifies v Version
  58  , Reifies c crypto
  59  , Group crypto
  60  , ToJSON (FieldElement 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 (FieldElement crypto c) =>
  99  [Ballot crypto v c] -> (EncryptedTally crypto v c, Natural)
 100 encryptedTally = List.foldr insertEncryptedTally emptyEncryptedTally
 101
 102 -- | The initial 'EncryptedTally' which tallies no 'Ballot'.
 103 emptyEncryptedTally ::
 104  Reifies c crypto =>
 105  Multiplicative (FieldElement crypto c) =>
 106  (EncryptedTally crypto v c, Natural)
 107 emptyEncryptedTally = (List.repeat (List.repeat zero), 0)
 108
 109 -- | @('insertEncryptedTally' ballot encTally)@
 110 -- returns the 'EncryptedTally' adding the votes of the given @(ballot)@
 111 -- to those of the given @(encTally)@.
 112 insertEncryptedTally ::
 113  Reifies c crypto =>
 114  Multiplicative (FieldElement crypto c) =>
 115  Ballot crypto v c -> (EncryptedTally crypto v c, Natural) -> (EncryptedTally crypto v c, Natural)
 116 insertEncryptedTally Ballot{..} (encTally, numBallots) =
 117         ( List.zipWith
 118                  (\Answer{..} -> List.zipWith (+) (fst <$> answer_opinions))
 119                  ballot_answers
 120                  encTally
 121         , numBallots+1
 122         )
 123
 124 -- ** Type 'DecryptionShareCombinator'
 125 type DecryptionShareCombinator crypto v c =
 126  EncryptedTally crypto v c ->
 127  [DecryptionShare crypto v c] ->
 128  Except ErrorTally [[DecryptionFactor crypto c]]
 129
 130 proveTally ::
 131  Reifies c crypto =>
 132  Group crypto =>
 133  Multiplicative (FieldElement crypto c) =>
 134  Ord (FieldElement crypto c) =>
 135  (EncryptedTally crypto v c, Natural) -> [DecryptionShare crypto v c] ->
 136  DecryptionShareCombinator crypto v c ->
 137  Except ErrorTally (Tally crypto v c)
 138 proveTally
 139  (tally_encByChoiceByQuest, tally_countMax)
 140  tally_decShareByTrustee
 141  decShareCombinator = do
 142         decFactorByChoiceByQuest <-
 143                 decShareCombinator
 144                  tally_encByChoiceByQuest
 145                  tally_decShareByTrustee
 146         dec <- isoZipWithM (throwE ErrorTally_NumberOfQuestions)
 147          (maybe (throwE ErrorTally_NumberOfChoices) return `o2`
 148                 isoZipWith (\Encryption{..} decFactor -> encryption_vault / decFactor))
 149          tally_encByChoiceByQuest
 150          decFactorByChoiceByQuest
 151         let logMap = Map.fromList $ List.zip groupGenPowers [0..tally_countMax]
 152         let log x =
 153                 maybe (throwE ErrorTally_CannotDecryptCount) return $
 154                 Map.lookup x logMap
 155         tally_countByChoiceByQuest <- (log `mapM`)`mapM`dec
 156         return Tally{..}
 157
 158 verifyTally ::
 159  Reifies c crypto =>
 160  Group crypto =>
 161  Multiplicative (FieldElement crypto c) =>
 162  Eq (FieldElement crypto c) =>
 163  Tally crypto v c ->
 164  DecryptionShareCombinator crypto v c ->
 165  Except ErrorTally ()
 166 verifyTally Tally{..} decShareCombinator = do
 167         decFactorByChoiceByQuest <- decShareCombinator tally_encByChoiceByQuest tally_decShareByTrustee
 168         isoZipWith3M_ (throwE ErrorTally_NumberOfQuestions)
 169          (isoZipWith3M_ (throwE ErrorTally_NumberOfChoices)
 170                  (\Encryption{..} decFactor count -> do
 171                         let groupGenPowCount = encryption_vault / decFactor
 172                         unless (groupGenPowCount == groupGen ^ fromNatural count) $
 173                                 throwE ErrorTally_WrongProof))
 174          tally_encByChoiceByQuest
 175          decFactorByChoiceByQuest
 176          tally_countByChoiceByQuest
 177
 178 -- ** Type 'DecryptionShare'
 179 -- | A decryption share is a 'DecryptionFactor' and a decryption 'Proof', by choice by 'Question'.
 180 -- Computed by a trustee in 'proveDecryptionShare'.
 181 newtype DecryptionShare crypto v c = DecryptionShare
 182  { unDecryptionShare :: [[(DecryptionFactor crypto c, Proof crypto v c)]] }
 183  deriving (Generic)
 184 deriving instance Eq (FieldElement crypto c) => Eq (DecryptionShare crypto v c)
 185 deriving instance Show (G crypto c) => Show (DecryptionShare crypto v c)
 186 deriving newtype instance NFData (FieldElement crypto c) => NFData (DecryptionShare crypto v c)
 187 instance
 188  ( Group crypto
 189  , ToJSON (FieldElement crypto c)
 190  ) => ToJSON (DecryptionShare crypto v c) where
 191         toJSON (DecryptionShare decByChoiceByQuest) =
 192                 JSON.object
 193                  [ "decryption_factors" .=
 194                         toJSONList (((toJSON . fst) <$>) <$> decByChoiceByQuest)
 195                  , "decryption_proofs" .=
 196                         toJSONList (((toJSON . snd) <$>) <$> decByChoiceByQuest)
 197                  ]
 198         toEncoding (DecryptionShare decByChoiceByQuest) =
 199                 JSON.pairs $
 200                         JSON.pair "decryption_factors"
 201                          (JSON.list (JSON.list (toEncoding . fst)) decByChoiceByQuest) <>
 202                         JSON.pair "decryption_proofs"
 203                          (JSON.list (JSON.list (toEncoding . snd)) decByChoiceByQuest)
 204 instance
 205  ( Reifies c crypto
 206  , Group crypto
 207  , FromJSON (G crypto c)
 208  ) => FromJSON (DecryptionShare crypto v c) where
 209         parseJSON = JSON.withObject "DecryptionShare" $ \o -> do
 210                 decFactors <- o .: "decryption_factors"
 211                 decProofs  <- o .: "decryption_proofs"
 212                 let err msg = JSON.typeMismatch ("DecryptionShare: "<>msg) (JSON.Object o)
 213                 DecryptionShare
 214                  <$> isoZipWithM (err "inconsistent number of questions")
 215                          (isoZipWithM (err "inconsistent number of choices")
 216                                  (\a b -> return (a, b)))
 217                  decFactors decProofs
 218
 219 -- *** Type 'DecryptionFactor'
 220 -- | @'encryption_nonce' '^'trusteeSecKey@
 221 type DecryptionFactor = G
 222
 223 -- @('proveDecryptionShare' encByChoiceByQuest trusteeSecKey)@
 224 proveDecryptionShare ::
 225  Reifies v Version =>
 226  Reifies c crypto =>
 227  Group crypto =>
 228  Multiplicative (FieldElement crypto c) =>
 229  Key crypto =>
 230  ToNatural (FieldElement crypto c) =>
 231  Monad m => RandomGen r =>
 232  EncryptedTally crypto v c -> SecretKey crypto c -> S.StateT r m (DecryptionShare crypto v c)
 233 proveDecryptionShare encByChoiceByQuest trusteeSecKey =
 234         (DecryptionShare <$>) $
 235         (proveDecryptionFactor trusteeSecKey `mapM`) `mapM` encByChoiceByQuest
 236
 237 proveDecryptionFactor ::
 238  Reifies v Version =>
 239  Reifies c crypto =>
 240  Group crypto =>
 241  Multiplicative (FieldElement crypto c) =>
 242  Key crypto =>
 243  ToNatural (FieldElement crypto c) =>
 244  Monad m => RandomGen r =>
 245  SecretKey crypto c -> Encryption crypto v c -> S.StateT r m (DecryptionFactor crypto c, Proof crypto v c)
 246 proveDecryptionFactor trusteeSecKey Encryption{..} = do
 247         proof <- prove trusteeSecKey [groupGen, encryption_nonce] (hash zkp)
 248         return (encryption_nonce^trusteeSecKey, proof)
 249         where zkp = decryptionShareStatement (publicKey trusteeSecKey)
 250
 251 decryptionShareStatement ::
 252  Reifies c crypto =>
 253  ToNatural (FieldElement crypto c) =>
 254  PublicKey crypto c -> BS.ByteString
 255 decryptionShareStatement pubKey =
 256         "decrypt|"<>bytesNat pubKey<>"|"
 257
 258 -- *** Type 'ErrorTally'
 259 data ErrorTally
 260  =   ErrorTally_NumberOfQuestions
 261      -- ^ The number of 'Question's is not the one expected.
 262  |   ErrorTally_NumberOfChoices
 263      -- ^ The number of choices is not the one expected.
 264  |   ErrorTally_NumberOfTrustees
 265      -- ^ The number of trustees is not the one expected.
 266  |   ErrorTally_WrongProof
 267      -- ^ The 'Proof' of a 'DecryptionFactor' is wrong.
 268  |   ErrorTally_CannotDecryptCount
 269      -- ^ Raised by 'proveTally' when the discrete logarithm of @'groupGen' '^'count@
 270      -- cannot be computed, likely because 'tally_countMax' is wrong,
 271      -- or because the 'EncryptedTally' or 'DecryptionShare's have not been verified.
 272  deriving (Eq,Show,Generic,NFData)
 273
 274 -- | @('verifyDecryptionShare' encTally trusteePubKey trusteeDecShare)@
 275 -- checks that 'trusteeDecShare'
 276 -- (supposedly submitted by a trustee whose 'PublicKey' is 'trusteePubKey')
 277 -- is valid with respect to the 'EncryptedTally' 'encTally'.
 278 verifyDecryptionShare ::
 279  Reifies v Version =>
 280  Reifies c crypto =>
 281  Group crypto =>
 282  Multiplicative (FieldElement crypto c) =>
 283  ToNatural (FieldElement crypto c) =>
 284  Monad m =>
 285  EncryptedTally crypto v c -> PublicKey crypto c -> DecryptionShare crypto v c ->
 286  ExceptT ErrorTally m ()
 287 verifyDecryptionShare encByChoiceByQuest trusteePubKey (DecryptionShare decShare) =
 288         let zkp = decryptionShareStatement trusteePubKey in
 289         isoZipWithM_ (throwE ErrorTally_NumberOfQuestions)
 290          (isoZipWithM_ (throwE ErrorTally_NumberOfChoices) $
 291          \Encryption{..} (decFactor, proof) ->
 292                 unless (proof_challenge proof == hash zkp
 293                  [ commit proof groupGen trusteePubKey
 294                  , commit proof encryption_nonce decFactor
 295                  ]) $ throwE ErrorTally_WrongProof)
 296          encByChoiceByQuest
 297          decShare
 298
 299 verifyDecryptionShareByTrustee ::
 300  Reifies v Version =>
 301  Reifies c crypto =>
 302  Group crypto =>
 303  Multiplicative (FieldElement crypto c) =>
 304  ToNatural (FieldElement crypto c) =>
 305  Monad m =>
 306  EncryptedTally crypto v c -> [PublicKey crypto c] -> [DecryptionShare crypto v c] ->
 307  ExceptT ErrorTally m ()
 308 verifyDecryptionShareByTrustee encTally =
 309         isoZipWithM_ (throwE ErrorTally_NumberOfTrustees)
 310          (verifyDecryptionShare encTally)