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