{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-}
module Voting.Protocol.Tally where
import Control.DeepSeq (NFData)
import Control.Monad (Monad(..), mapM, unless)
import Control.Monad.Trans.Except (Except, ExceptT, throwE)
import Data.Aeson (ToJSON(..),FromJSON(..))
import Data.Eq (Eq(..))
import Data.Function (($))
import Data.Functor ((<$>))
import Data.Maybe (maybe)
import Data.Semigroup (Semigroup(..))
import Data.Tuple (fst)
import GHC.Generics (Generic)
import Numeric.Natural (Natural)
import Prelude (fromIntegral)
import Text.Show (Show(..))
import qualified Control.Monad.Trans.State.Strict as S
import qualified Data.ByteString as BS
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import Voting.Protocol.Utils
import Voting.Protocol.FFC
import Voting.Protocol.Credential
import Voting.Protocol.Election
data Tally c = Tally
{ tally_countMax :: !Natural
, tally_encByChoiceByQuest :: !(EncryptedTally c)
, tally_decShareByTrustee :: ![DecryptionShare c]
, tally_countByChoiceByQuest :: ![[Natural]]
} deriving (Eq,Show,Generic,NFData)
deriving instance Reifies c FFC => ToJSON (Tally c)
deriving instance Reifies c FFC => FromJSON (Tally c)
type EncryptedTally c = [[Encryption c]]
encryptedTally :: Reifies c FFC => [Ballot c] -> (EncryptedTally c, Natural)
encryptedTally ballots =
( List.foldr (\Ballot{..} ->
List.zipWith (\Answer{..} ->
List.zipWith (+)
(fst <$> answer_opinions))
ballot_answers)
(List.repeat (List.repeat zero))
ballots
, fromIntegral $ List.length ballots
)
type DecryptionShareCombinator c =
EncryptedTally c -> [DecryptionShare c] -> Except ErrorTally [[DecryptionFactor c]]
proveTally ::
Reifies c FFC =>
(EncryptedTally c, Natural) -> [DecryptionShare c] ->
DecryptionShareCombinator c ->
Except ErrorTally (Tally c)
proveTally
(tally_encByChoiceByQuest, tally_countMax)
tally_decShareByTrustee
decShareCombinator = do
decFactorByChoiceByQuest <-
decShareCombinator
tally_encByChoiceByQuest
tally_decShareByTrustee
dec <- isoZipWithM (throwE ErrorTally_NumberOfQuestions)
(maybe (throwE ErrorTally_NumberOfChoices) return `o2`
isoZipWith (\Encryption{..} decFactor -> encryption_vault / decFactor))
tally_encByChoiceByQuest
decFactorByChoiceByQuest
let logMap = Map.fromList $ List.zip groupGenPowers [0..tally_countMax]
let log x =
maybe (throwE ErrorTally_CannotDecryptCount) return $
Map.lookup x logMap
tally_countByChoiceByQuest <- (log `mapM`)`mapM`dec
return Tally{..}
verifyTally ::
Reifies c FFC =>
Tally c -> DecryptionShareCombinator c ->
Except ErrorTally ()
verifyTally Tally{..} decShareCombinator = do
decFactorByChoiceByQuest <- decShareCombinator tally_encByChoiceByQuest tally_decShareByTrustee
isoZipWith3M_ (throwE ErrorTally_NumberOfQuestions)
(isoZipWith3M_ (throwE ErrorTally_NumberOfChoices)
(\Encryption{..} decFactor count -> do
let groupGenPowCount = encryption_vault / decFactor
unless (groupGenPowCount == groupGen ^ fromNatural count) $
throwE ErrorTally_WrongProof))
tally_encByChoiceByQuest
decFactorByChoiceByQuest
tally_countByChoiceByQuest
type DecryptionShare c = [[(DecryptionFactor c, Proof c)]]
type DecryptionFactor = G
proveDecryptionShare ::
Monad m => Reifies c FFC => RandomGen r =>
EncryptedTally c -> SecretKey c -> S.StateT r m (DecryptionShare c)
proveDecryptionShare encByChoiceByQuest trusteeSecKey =
(proveDecryptionFactor trusteeSecKey `mapM`) `mapM` encByChoiceByQuest
proveDecryptionFactor ::
Monad m => Reifies c FFC => RandomGen r =>
SecretKey c -> Encryption c -> S.StateT r m (DecryptionFactor c, Proof c)
proveDecryptionFactor trusteeSecKey Encryption{..} = do
proof <- prove trusteeSecKey [groupGen, encryption_nonce] (hash zkp)
return (encryption_nonce^trusteeSecKey, proof)
where zkp = decryptionShareStatement (publicKey trusteeSecKey)
decryptionShareStatement :: Reifies c FFC => PublicKey c -> BS.ByteString
decryptionShareStatement pubKey =
"decrypt|"<>bytesNat pubKey<>"|"
data ErrorTally
= ErrorTally_NumberOfQuestions
| ErrorTally_NumberOfChoices
| ErrorTally_NumberOfTrustees
| ErrorTally_WrongProof
| ErrorTally_CannotDecryptCount
deriving (Eq,Show,Generic,NFData)
verifyDecryptionShare ::
Monad m => Reifies c FFC =>
EncryptedTally c -> PublicKey c -> DecryptionShare c ->
ExceptT ErrorTally m ()
verifyDecryptionShare encByChoiceByQuest trusteePubKey =
let zkp = decryptionShareStatement trusteePubKey in
isoZipWithM_ (throwE ErrorTally_NumberOfQuestions)
(isoZipWithM_ (throwE ErrorTally_NumberOfChoices) $
\Encryption{..} (decFactor, proof) ->
unless (proof_challenge proof == hash zkp
[ commit proof groupGen trusteePubKey
, commit proof encryption_nonce decFactor
]) $ throwE ErrorTally_WrongProof)
encByChoiceByQuest
verifyDecryptionShareByTrustee ::
Monad m => Reifies c FFC =>
EncryptedTally c -> [PublicKey c] -> [DecryptionShare c] ->
ExceptT ErrorTally m ()
verifyDecryptionShareByTrustee encTally =
isoZipWithM_ (throwE ErrorTally_NumberOfTrustees)
(verifyDecryptionShare encTally)