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