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.Reflection (Reifies(..))
  16 import Data.Semigroup (Semigroup(..))
  17 import Data.Tuple (fst)
  18 import GHC.Generics (Generic)
  19 import System.Random (RandomGen)
  20 import Text.Show (Show(..))
  21 import qualified Control.Monad.Trans.State.Strict as S
  22 import qualified Data.Aeson as JSON
  23 import qualified Data.ByteString as BS
  24 import qualified Data.List as List
  25
  26 import Voting.Protocol.Utils
  27 import Voting.Protocol.Arith
  28 import Voting.Protocol.Credential
  29 import Voting.Protocol.Election
  30 import Voting.Protocol.Tally
  31
  32 -- * Type 'TrusteePublicKey'
  33 data TrusteePublicKey crypto v c = TrusteePublicKey
  34  { trustee_PublicKey      :: !(PublicKey crypto c)
  35  , trustee_SecretKeyProof :: !(Proof crypto v c)
  36         -- ^ NOTE: It is important to ensure
  37         -- that each trustee generates its key pair independently
  38         -- of the 'PublicKey's published by the other trustees.
  39         -- Otherwise, a dishonest trustee could publish as 'PublicKey'
  40         -- its genuine 'PublicKey' divided by the 'PublicKey's of the other trustees.
  41         -- This would then lead to the 'election_PublicKey'
  42         -- being equal to this dishonest trustee's 'PublicKey',
  43         -- which means that knowing its 'SecretKey' would be sufficient
  44         -- for decrypting messages encrypted to the 'election_PublicKey'.
  45         -- To avoid this attack, each trustee publishing a 'PublicKey'
  46         -- must 'prove' knowledge of the corresponding 'SecretKey'.
  47         -- Which is done in 'proveIndispensableTrusteePublicKey'
  48         -- and 'verifyIndispensableTrusteePublicKey'.
  49  } deriving (Generic)
  50 deriving instance Eq (FieldElement crypto c) => Eq (TrusteePublicKey crypto v c)
  51 deriving instance (Show (FieldElement crypto c), Show (PublicKey crypto c)) => Show (TrusteePublicKey crypto v c)
  52 deriving instance NFData (FieldElement crypto c) => NFData (TrusteePublicKey crypto v c)
  53 instance
  54  ( Group crypto
  55  , ToJSON (FieldElement crypto c)
  56  ) => ToJSON (TrusteePublicKey crypto v c) where
  57         toJSON TrusteePublicKey{..} =
  58                 JSON.object
  59                  [ "pok"        .= trustee_SecretKeyProof
  60                  , "public_key" .= trustee_PublicKey
  61                  ]
  62         toEncoding TrusteePublicKey{..} =
  63                 JSON.pairs
  64                  (  "pok"        .= trustee_SecretKeyProof
  65                  <> "public_key" .= trustee_PublicKey
  66                  )
  67 instance
  68  ( Reifies c crypto
  69  , Group crypto
  70  , FromJSON (PublicKey crypto c)
  71  ) => FromJSON (TrusteePublicKey crypto v c) where
  72         parseJSON = JSON.withObject "TrusteePublicKey" $ \o -> do
  73                 trustee_PublicKey <- o .: "public_key"
  74                 trustee_SecretKeyProof <- o .: "pok"
  75                 return TrusteePublicKey{..}
  76
  77 -- ** Generating a 'TrusteePublicKey'
  78
  79 -- | @('proveIndispensableTrusteePublicKey' trustSecKey)@
  80 -- returns the 'PublicKey' associated to 'trustSecKey'
  81 -- and a 'Proof' of its knowledge.
  82 proveIndispensableTrusteePublicKey ::
  83  Reifies v Version =>
  84  Reifies c crypto =>
  85  Group crypto =>
  86  Key crypto =>
  87  Multiplicative (FieldElement crypto c) =>
  88  ToNatural (FieldElement crypto c) =>
  89  Monad m => RandomGen r =>
  90  SecretKey crypto c -> S.StateT r m (TrusteePublicKey crypto v c)
  91 proveIndispensableTrusteePublicKey trustSecKey = do
  92         let trustee_PublicKey = publicKey trustSecKey
  93         trustee_SecretKeyProof <-
  94                 prove trustSecKey [groupGen] $
  95                         hash (indispensableTrusteePublicKeyStatement trustee_PublicKey)
  96         return TrusteePublicKey{..}
  97
  98 -- ** Checking a 'TrusteePublicKey' before incorporating it into the 'Election''s 'PublicKey'
  99
 100 -- | @('verifyIndispensableTrusteePublicKey' trustPubKey)@
 101 -- returns 'True' iif. the given 'trustee_SecretKeyProof'
 102 -- does 'prove' that the 'SecretKey' associated with
 103 -- the given 'trustee_PublicKey' is known by the trustee.
 104 verifyIndispensableTrusteePublicKey ::
 105  Reifies v Version =>
 106  Reifies c crypto =>
 107  Group crypto =>
 108  Multiplicative (FieldElement crypto c) =>
 109  ToNatural (FieldElement crypto c) =>
 110  Monad m =>
 111  TrusteePublicKey crypto v c ->
 112  ExceptT ErrorTrusteePublicKey m ()
 113 verifyIndispensableTrusteePublicKey TrusteePublicKey{..} =
 114         unless (
 115                 proof_challenge trustee_SecretKeyProof == hash
 116                  (indispensableTrusteePublicKeyStatement trustee_PublicKey)
 117                  [commit trustee_SecretKeyProof groupGen trustee_PublicKey]
 118          ) $
 119                 throwE ErrorTrusteePublicKey_WrongProof
 120
 121 -- ** Type 'ErrorTrusteePublicKey'
 122 data ErrorTrusteePublicKey
 123  =   ErrorTrusteePublicKey_WrongProof
 124      -- ^ The 'trustee_SecretKeyProof' is wrong.
 125  deriving (Eq,Show)
 126
 127 -- ** Hashing
 128 indispensableTrusteePublicKeyStatement ::
 129  Reifies c crypto =>
 130  ToNatural (FieldElement crypto c) =>
 131  PublicKey crypto c -> BS.ByteString
 132 indispensableTrusteePublicKeyStatement trustPubKey =
 133         "pok|"<>bytesNat trustPubKey<>"|"
 134
 135 -- * 'Election''s 'PublicKey'
 136
 137 -- ** Generating an 'Election''s 'PublicKey' from multiple 'TrusteePublicKey's.
 138
 139 combineIndispensableTrusteePublicKeys ::
 140  Reifies c crypto =>
 141  Multiplicative (FieldElement crypto c) =>
 142  ToNatural (FieldElement crypto c) =>
 143  [TrusteePublicKey crypto v c] -> PublicKey crypto c
 144 combineIndispensableTrusteePublicKeys =
 145         List.foldr (\TrusteePublicKey{..} -> (trustee_PublicKey *)) one
 146
 147 -- ** Checking the trustee's 'DecryptionShare's before decrypting an 'EncryptedTally'.
 148
 149 verifyIndispensableDecryptionShareByTrustee ::
 150  Reifies v Version =>
 151  Reifies c crypto =>
 152  Group crypto =>
 153  Multiplicative (FieldElement crypto c) =>
 154  ToNatural (FieldElement crypto c) =>
 155  Monad m =>
 156  EncryptedTally crypto v c -> [PublicKey crypto c] -> [DecryptionShare crypto v c] ->
 157  ExceptT ErrorTally m ()
 158 verifyIndispensableDecryptionShareByTrustee encByChoiceByQuest =
 159         isoZipWithM_ (throwE $ ErrorTally_NumberOfTrustees)
 160          (verifyDecryptionShare encByChoiceByQuest)
 161
 162 -- ** Decrypting an 'EncryptedTally' from multiple 'TrusteePublicKey's.
 163
 164 -- | @('combineDecryptionShares' pubKeyByTrustee decShareByTrustee)@
 165 -- returns the 'DecryptionFactor's by choice by 'Question'
 166 combineIndispensableDecryptionShares ::
 167  Reifies v Version =>
 168  Reifies c crypto =>
 169  Group crypto =>
 170  Multiplicative (FieldElement crypto c) =>
 171  ToNatural (FieldElement crypto c) =>
 172  [PublicKey crypto c] -> DecryptionShareCombinator crypto v c
 173 combineIndispensableDecryptionShares
 174  pubKeyByTrustee
 175  encByChoiceByQuest
 176  decByChoiceByQuestByTrustee = do
 177         verifyIndispensableDecryptionShareByTrustee
 178          encByChoiceByQuest
 179          pubKeyByTrustee
 180          decByChoiceByQuestByTrustee
 181         (DecryptionShare dec0,decs) <-
 182                 maybe (throwE ErrorTally_NumberOfTrustees) return $
 183                 List.uncons decByChoiceByQuestByTrustee
 184         foldM (isoZipWithM (throwE ErrorTally_NumberOfQuestions)
 185          (maybe (throwE ErrorTally_NumberOfChoices) return `o2`
 186                 isoZipWith (\a (decFactor, _proof) -> a * decFactor)))
 187          ((fst <$>) <$> dec0) (unDecryptionShare <$> decs)