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 -- ** Type 'ErrorTrusteePublicKey'
  66 data ErrorTrusteePublicKey
  67  =   ErrorTrusteePublicKey_WrongProof
  68      -- ^ The 'trustee_SecretKeyProof' is wrong.
  69  deriving (Eq,Show)
  70
  71 -- | @('proveIndispensableTrusteePublicKey' trustSecKey)@
  72 -- returns the 'PublicKey' associated to 'trustSecKey'
  73 -- and a 'Proof' of its knowledge.
  74 proveIndispensableTrusteePublicKey ::
  75  Reifies c FFC => Monad m => RandomGen r =>
  76  SecretKey c -> S.StateT r m (TrusteePublicKey c)
  77 proveIndispensableTrusteePublicKey trustSecKey = do
  78         let trustee_PublicKey = publicKey trustSecKey
  79         trustee_SecretKeyProof <-
  80                 prove trustSecKey [groupGen] $
  81                         hash (indispensableTrusteePublicKeyStatement trustee_PublicKey)
  82         return TrusteePublicKey{..}
  83
  84 -- | @('verifyIndispensableTrusteePublicKey' trustPubKey)@
  85 -- returns 'True' iif. the given 'trustee_SecretKeyProof'
  86 -- does 'prove' that the 'SecretKey' associated with
  87 -- the given 'trustee_PublicKey' is known by the trustee.
  88 verifyIndispensableTrusteePublicKey ::
  89  Reifies c FFC => Monad m =>
  90  TrusteePublicKey c ->
  91  ExceptT ErrorTrusteePublicKey m ()
  92 verifyIndispensableTrusteePublicKey TrusteePublicKey{..} =
  93         unless ((proof_challenge trustee_SecretKeyProof ==) $
  94         hash
  95          (indispensableTrusteePublicKeyStatement trustee_PublicKey)
  96          [commit trustee_SecretKeyProof groupGen trustee_PublicKey]) $
  97                 throwE ErrorTrusteePublicKey_WrongProof
  98
  99 -- ** Hashing
 100 indispensableTrusteePublicKeyStatement :: PublicKey c -> BS.ByteString
 101 indispensableTrusteePublicKeyStatement trustPubKey =
 102         "pok|"<>bytesNat trustPubKey<>"|"
 103
 104 -- * 'Election''s 'PublicKey'
 105
 106 combineIndispensableTrusteePublicKeys ::
 107  Reifies c FFC => [TrusteePublicKey c] -> PublicKey c
 108 combineIndispensableTrusteePublicKeys =
 109         List.foldr (\TrusteePublicKey{..} -> (trustee_PublicKey *)) one
 110
 111 verifyIndispensableDecryptionShareByTrustee ::
 112  Reifies c FFC => Monad m =>
 113  EncryptedTally c -> [PublicKey c] -> [DecryptionShare c] ->
 114  ExceptT ErrorTally m ()
 115 verifyIndispensableDecryptionShareByTrustee encByChoiceByQuest =
 116         isoZipWithM_ (throwE $ ErrorTally_NumberOfTrustees)
 117          (verifyDecryptionShare encByChoiceByQuest)
 118
 119 -- | @('combineDecryptionShares' pubKeyByTrustee decShareByTrustee)@
 120 -- returns the 'DecryptionFactor's by choice by 'Question'
 121 combineIndispensableDecryptionShares ::
 122  Reifies c FFC => [PublicKey c] -> DecryptionShareCombinator c
 123 combineIndispensableDecryptionShares
 124  pubKeyByTrustee
 125  encByChoiceByQuest
 126  decByChoiceByQuestByTrustee = do
 127         verifyIndispensableDecryptionShareByTrustee
 128          encByChoiceByQuest
 129          pubKeyByTrustee
 130          decByChoiceByQuestByTrustee
 131         (DecryptionShare dec0,decs) <-
 132                 maybe (throwE ErrorTally_NumberOfTrustees) return $
 133                 List.uncons decByChoiceByQuestByTrustee
 134         foldM (isoZipWithM (throwE ErrorTally_NumberOfQuestions)
 135          (maybe (throwE ErrorTally_NumberOfChoices) return `o2`
 136                 isoZipWith (\a (decFactor, _proof) -> a * decFactor)))
 137          ((fst <$>) <$> dec0) (unDecryptionShare <$> decs)