{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE UndecidableInstances #-} -- for Reifies instances module Voting.Protocol.Trustee.Indispensable where import Control.DeepSeq (NFData) import Control.Monad (Monad(..), foldM, unless) import Control.Monad.Trans.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 Text.Show (Show(..)) import qualified Control.Monad.Trans.State.Strict as S import qualified Data.Aeson as JSON import qualified Data.ByteString as BS import qualified Data.List as List import Voting.Protocol.Utils import Voting.Protocol.FFC import Voting.Protocol.Credential import Voting.Protocol.Election import Voting.Protocol.Tally -- * Type 'TrusteePublicKey' data TrusteePublicKey c = TrusteePublicKey { trustee_PublicKey :: !(PublicKey c) , trustee_SecretKeyProof :: !(Proof c) -- ^ NOTE: It is important to ensure -- that each trustee generates its key pair independently -- of the 'PublicKey's published by the other trustees. -- Otherwise, a dishonest trustee could publish as 'PublicKey' -- its genuine 'PublicKey' divided by the 'PublicKey's of the other trustees. -- This would then lead to the 'election_PublicKey' -- being equal to this dishonest trustee's 'PublicKey', -- which means that knowing its 'SecretKey' would be sufficient -- for decrypting messages encrypted to the 'election_PublicKey'. -- To avoid this attack, each trustee publishing a 'PublicKey' -- must 'prove' knowledge of the corresponding 'SecretKey'. -- Which is done in 'proveIndispensableTrusteePublicKey' -- and 'verifyIndispensableTrusteePublicKey'. } deriving (Eq,Show,Generic,NFData) instance ToJSON (TrusteePublicKey c) where toJSON TrusteePublicKey{..} = JSON.object [ "pok" .= trustee_SecretKeyProof , "public_key" .= trustee_PublicKey ] toEncoding TrusteePublicKey{..} = JSON.pairs ( "pok" .= trustee_SecretKeyProof <> "public_key" .= trustee_PublicKey ) instance Reifies c FFC => FromJSON (TrusteePublicKey c) where parseJSON = JSON.withObject "TrusteePublicKey" $ \o -> do trustee_PublicKey <- o .: "public_key" trustee_SecretKeyProof <- o .: "pok" return TrusteePublicKey{..} -- ** Type 'ErrorTrusteePublicKey' data ErrorTrusteePublicKey = ErrorTrusteePublicKey_WrongProof -- ^ The 'trustee_SecretKeyProof' is wrong. deriving (Eq,Show) -- | @('proveIndispensableTrusteePublicKey' trustSecKey)@ -- returns the 'PublicKey' associated to 'trustSecKey' -- and a 'Proof' of its knowledge. proveIndispensableTrusteePublicKey :: Reifies c FFC => Monad m => RandomGen r => SecretKey c -> S.StateT r m (TrusteePublicKey c) proveIndispensableTrusteePublicKey trustSecKey = do let trustee_PublicKey = publicKey trustSecKey trustee_SecretKeyProof <- prove trustSecKey [groupGen] $ hash (indispensableTrusteePublicKeyStatement trustee_PublicKey) return TrusteePublicKey{..} -- | @('verifyIndispensableTrusteePublicKey' trustPubKey)@ -- returns 'True' iif. the given 'trustee_SecretKeyProof' -- does 'prove' that the 'SecretKey' associated with -- the given 'trustee_PublicKey' is known by the trustee. verifyIndispensableTrusteePublicKey :: Reifies c FFC => Monad m => TrusteePublicKey c -> ExceptT ErrorTrusteePublicKey m () verifyIndispensableTrusteePublicKey TrusteePublicKey{..} = unless ((proof_challenge trustee_SecretKeyProof ==) $ hash (indispensableTrusteePublicKeyStatement trustee_PublicKey) [commit trustee_SecretKeyProof groupGen trustee_PublicKey]) $ throwE ErrorTrusteePublicKey_WrongProof -- ** Hashing indispensableTrusteePublicKeyStatement :: PublicKey c -> BS.ByteString indispensableTrusteePublicKeyStatement trustPubKey = "pok|"<>bytesNat trustPubKey<>"|" -- * 'Election''s 'PublicKey' combineIndispensableTrusteePublicKeys :: Reifies c FFC => [TrusteePublicKey c] -> PublicKey c combineIndispensableTrusteePublicKeys = List.foldr (\TrusteePublicKey{..} -> (trustee_PublicKey *)) one verifyIndispensableDecryptionShareByTrustee :: Reifies c FFC => Monad m => EncryptedTally c -> [PublicKey c] -> [DecryptionShare c] -> ExceptT ErrorTally m () verifyIndispensableDecryptionShareByTrustee encByChoiceByQuest = isoZipWithM_ (throwE $ ErrorTally_NumberOfTrustees) (verifyDecryptionShare encByChoiceByQuest) -- | @('combineDecryptionShares' pubKeyByTrustee decShareByTrustee)@ -- returns the 'DecryptionFactor's by choice by 'Question' combineIndispensableDecryptionShares :: Reifies c FFC => [PublicKey c] -> DecryptionShareCombinator c combineIndispensableDecryptionShares pubKeyByTrustee encByChoiceByQuest decByChoiceByQuestByTrustee = do verifyIndispensableDecryptionShareByTrustee encByChoiceByQuest pubKeyByTrustee decByChoiceByQuestByTrustee (DecryptionShare dec0,decs) <- maybe (throwE ErrorTally_NumberOfTrustees) return $ List.uncons decByChoiceByQuestByTrustee foldM (isoZipWithM (throwE ErrorTally_NumberOfQuestions) (maybe (throwE ErrorTally_NumberOfChoices) return `o2` isoZipWith (\a (decFactor, _proof) -> a * decFactor))) ((fst <$>) <$> dec0) (unDecryptionShare <$> decs)