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