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

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