hjugement-protocol/src/Voting/Protocol/Trustee/Indispensable.hs

   1 {-# LANGUAGE DeriveAnyClass #-}
   2 {-# LANGUAGE DeriveGeneric #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4 {-# LANGUAGE UndecidableInstances #-} -- for Reifies instances
   5 module Voting.Protocol.Trustee.Indispensable where
   6
   7 import Control.DeepSeq (NFData)
   8 import Control.Monad (Monad(..), foldM, unless)
   9 import Control.Monad.Trans.Except (ExceptT(..), throwE)
  10 import Data.Aeson (ToJSON(..),FromJSON(..))
  11 import Data.Eq (Eq(..))
  12 import Data.Function (($))
  13 import Data.Functor ((<$>))
  14 import Data.Maybe (maybe)
  15 import Data.Semigroup (Semigroup(..))
  16 import Data.Tuple (fst)
  17 import GHC.Generics (Generic)
  18 import Text.Show (Show(..))
  19 import qualified Control.Monad.Trans.State.Strict as S
  20 import qualified Data.ByteString as BS
  21 import qualified Data.List as List
  22
  23 import Voting.Protocol.Utils
  24 import Voting.Protocol.FFC
  25 import Voting.Protocol.Credential
  26 import Voting.Protocol.Election
  27 import Voting.Protocol.Tally
  28
  29 -- * Type 'TrusteePublicKey'
  30 data TrusteePublicKey c = TrusteePublicKey
  31  { trustee_PublicKey      :: !(PublicKey c)
  32  , trustee_SecretKeyProof :: !(Proof c)
  33         -- ^ NOTE: It is important to ensure
  34         -- that each trustee generates its key pair independently
  35         -- of the 'PublicKey's published by the other trustees.
  36         -- Otherwise, a dishonest trustee could publish as 'PublicKey'
  37         -- its genuine 'PublicKey' divided by the 'PublicKey's of the other trustees.
  38         -- This would then lead to the 'election_PublicKey'
  39         -- being equal to this dishonest trustee's 'PublicKey',
  40         -- which means that knowing its 'SecretKey' would be sufficient
  41         -- for decrypting messages encrypted to the 'election_PublicKey'.
  42         -- To avoid this attack, each trustee publishing a 'PublicKey'
  43         -- must 'prove' knowledge of the corresponding 'SecretKey'.
  44         -- Which is done in 'proveIndispensableTrusteePublicKey'
  45         -- and 'verifyIndispensableTrusteePublicKey'.
  46  } deriving (Eq,Show,Generic,NFData)
  47 deriving instance Reifies c FFC => ToJSON (TrusteePublicKey c)
  48 deriving instance Reifies c FFC => FromJSON (TrusteePublicKey c)
  49
  50 -- ** Type 'ErrorTrusteePublicKey'
  51 data ErrorTrusteePublicKey
  52  =   ErrorTrusteePublicKey_WrongProof
  53      -- ^ The 'trustee_SecretKeyProof' is wrong.
  54  deriving (Eq,Show)
  55
  56 -- | @('proveIndispensableTrusteePublicKey' trustSecKey)@
  57 -- returns the 'PublicKey' associated to 'trustSecKey'
  58 -- and a 'Proof' of its knowledge.
  59 proveIndispensableTrusteePublicKey ::
  60  Reifies c FFC => Monad m => RandomGen r =>
  61  SecretKey c -> S.StateT r m (TrusteePublicKey c)
  62 proveIndispensableTrusteePublicKey trustSecKey = do
  63         let trustee_PublicKey = publicKey trustSecKey
  64         trustee_SecretKeyProof <-
  65                 prove trustSecKey [groupGen] $
  66                         hash (indispensableTrusteePublicKeyStatement trustee_PublicKey)
  67         return TrusteePublicKey{..}
  68
  69 -- | @('verifyIndispensableTrusteePublicKey' trustPubKey)@
  70 -- returns 'True' iif. the given 'trustee_SecretKeyProof'
  71 -- does 'prove' that the 'SecretKey' associated with
  72 -- the given 'trustee_PublicKey' is known by the trustee.
  73 verifyIndispensableTrusteePublicKey ::
  74  Reifies c FFC => Monad m =>
  75  TrusteePublicKey c ->
  76  ExceptT ErrorTrusteePublicKey m ()
  77 verifyIndispensableTrusteePublicKey TrusteePublicKey{..} =
  78         unless ((proof_challenge trustee_SecretKeyProof ==) $
  79         hash
  80          (indispensableTrusteePublicKeyStatement trustee_PublicKey)
  81          [commit trustee_SecretKeyProof groupGen trustee_PublicKey]) $
  82                 throwE ErrorTrusteePublicKey_WrongProof
  83
  84 -- ** Hashing
  85 indispensableTrusteePublicKeyStatement :: PublicKey c -> BS.ByteString
  86 indispensableTrusteePublicKeyStatement trustPubKey =
  87         "pok|"<>bytesNat trustPubKey<>"|"
  88
  89 -- * 'Election''s 'PublicKey'
  90
  91 combineIndispensableTrusteePublicKeys ::
  92  Reifies c FFC => [TrusteePublicKey c] -> PublicKey c
  93 combineIndispensableTrusteePublicKeys =
  94         List.foldr (\TrusteePublicKey{..} -> (trustee_PublicKey *)) one
  95
  96 verifyIndispensableDecryptionShareByTrustee ::
  97  Reifies c FFC => Monad m =>
  98  EncryptedTally c -> [PublicKey c] -> [DecryptionShare c] ->
  99  ExceptT ErrorTally m ()
 100 verifyIndispensableDecryptionShareByTrustee encByChoiceByQuest =
 101         isoZipWithM_ (throwE $ ErrorTally_NumberOfTrustees)
 102          (verifyDecryptionShare encByChoiceByQuest)
 103
 104 -- | @('combineDecryptionShares' pubKeyByTrustee decShareByTrustee)@
 105 -- returns the 'DecryptionFactor's by choice by 'Question'
 106 combineIndispensableDecryptionShares ::
 107  Reifies c FFC => [PublicKey c] -> DecryptionShareCombinator c
 108 combineIndispensableDecryptionShares
 109  pubKeyByTrustee
 110  encByChoiceByQuest
 111  decByChoiceByQuestByTrustee = do
 112         verifyIndispensableDecryptionShareByTrustee
 113          encByChoiceByQuest
 114          pubKeyByTrustee
 115          decByChoiceByQuestByTrustee
 116         (dec0,decs) <-
 117                 maybe (throwE ErrorTally_NumberOfTrustees) return $
 118                 List.uncons decByChoiceByQuestByTrustee
 119         foldM (isoZipWithM (throwE ErrorTally_NumberOfQuestions)
 120          (maybe (throwE ErrorTally_NumberOfChoices) return `o2`
 121                 isoZipWith (\a (decFactor, _proof) -> a * decFactor)))
 122          ((fst <$>) <$> dec0) decs