diff --git a/hjugement-protocol.cabal b/hjugement-protocol.cabal --- a/hjugement-protocol.cabal +++ b/hjugement-protocol.cabal @@ -2,7 +2,7 @@ -- PVP: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.0.1.20190623 +version: 0.0.4.20190711 category: Politic synopsis: A cryptographic protocol for the Majority Judgment. description: diff --git a/src/Voting/Protocol/Credential.hs b/src/Voting/Protocol/Credential.hs --- a/src/Voting/Protocol/Credential.hs +++ b/src/Voting/Protocol/Credential.hs @@ -5,7 +5,6 @@ import Control.DeepSeq (NFData) import Control.Monad (Monad(..), forM_, replicateM) -import Data.Bits import Data.Bool import Data.Char (Char) import Data.Either (Either(..), either) @@ -18,15 +17,12 @@ import Data.Semigroup (Semigroup(..)) import Data.Text (Text) import GHC.Generics (Generic) -import Numeric.Natural (Natural) -import Prelude (Integral(..), fromIntegral, div) +import Prelude (Integral(..), fromIntegral) import Text.Show (Show(..)) import qualified Control.Monad.Trans.State.Strict as S import qualified Crypto.KDF.PBKDF2 as Crypto import qualified Data.Aeson as JSON import qualified Data.Aeson.Types as JSON -import qualified Data.ByteArray as ByteArray -import qualified Data.ByteString as BS import qualified Data.Char as Char import qualified Data.List as List import qualified Data.Text as Text @@ -144,10 +140,7 @@ -- using 'Crypto.fastPBKDF2_SHA256'. credentialSecretKey :: Reifies c FFC => UUID -> Credential -> (SecretKey c) credentialSecretKey (UUID uuid) (Credential cred) = - fromNatural $ - BS.foldl' -- NOTE: interpret the SHA256 as a big-endian number. - (\acc b -> acc`shiftL`8 + fromIntegral b) - (0::Natural) $ + fromNatural $ decodeBigEndian $ Crypto.fastPBKDF2_SHA256 Crypto.Parameters { Crypto.iterCounts = 1000 diff --git a/src/Voting/Protocol/Election.hs b/src/Voting/Protocol/Election.hs --- a/src/Voting/Protocol/Election.hs +++ b/src/Voting/Protocol/Election.hs @@ -11,7 +11,7 @@ import Control.Monad (Monad(..), join, mapM, replicateM, zipWithM) import Control.Monad.Trans.Class (MonadTrans(..)) import Control.Monad.Trans.Except (ExceptT, runExcept, throwE, withExceptT) -import Data.Aeson (ToJSON(..),FromJSON(..),(.:),(.=)) +import Data.Aeson (ToJSON(..),FromJSON(..),(.:),(.:?),(.=)) import Data.Bool import Data.Either (either) import Data.Eq (Eq(..)) @@ -63,7 +63,11 @@ -- equal to @('pubKey' '^'encNone '*' 'groupGen' '^'clear)@ } deriving (Eq,Show,Generic,NFData) deriving instance Reifies c FFC => ToJSON (Encryption c) -deriving instance Reifies c FFC => FromJSON (Encryption c) +instance Reifies c FFC => FromJSON (Encryption c) where + parseJSON = JSON.withObject "Encryption" $ \o -> do + encryption_nonce <- o .: "alpha" + encryption_vault <- o .: "beta" + return Encryption{..} -- | Additive homomorphism. -- Using the fact that: @'groupGen' '^'x '*' 'groupGen' '^'y '==' 'groupGen' '^'(x'+'y)@. @@ -133,8 +137,22 @@ -- to ensure that each 'prove' does not reveal any information -- about its secret. } deriving (Eq,Show,Generic,NFData) -deriving instance Reifies c FFC => ToJSON (Proof c) -deriving instance Reifies c FFC => FromJSON (Proof c) +instance ToJSON (Proof c) where + toJSON Proof{..} = + JSON.object + [ "challenge" .= proof_challenge + , "response" .= proof_response + ] + toEncoding Proof{..} = + JSON.pairs + ( "challenge" .= proof_challenge + <> "response" .= proof_response + ) +instance Reifies c FFC => FromJSON (Proof c) where + parseJSON = JSON.withObject "TrusteePublicKey" $ \o -> do + proof_challenge <- o .: "challenge" + proof_response <- o .: "response" + return Proof{..} -- ** Type 'ZKP' -- | Zero-knowledge proof. @@ -369,7 +387,13 @@ -- , answer_blankProof :: } deriving (Eq,Show,Generic,NFData) deriving instance Reifies c FFC => ToJSON (Answer c) -deriving instance Reifies c FFC => FromJSON (Answer c) +instance Reifies c FFC => FromJSON (Answer c) where + parseJSON = JSON.withObject "Answer" $ \o -> do + answer_choices <- o .: "choices" + answer_individual_proofs <- o .: "individual_proofs" + let answer_opinions = List.zip answer_choices answer_individual_proofs + answer_sumProof <- o .: "overall_proof" + return Answer{..} -- | @('encryptAnswer' elecPubKey zkp quest opinions)@ -- returns an 'Answer' validable by 'verifyAnswer', @@ -491,7 +515,6 @@ reify ffc $ \(_::Proxy c) -> k @c Election{election_crypto = ElectionCrypto_FFC ffc (G (F pubKey)), ..} - instance ToJSON (ElectionCrypto c) where toJSON (ElectionCrypto_FFC ffc pubKey) = JSON.object @@ -534,7 +557,13 @@ , ballot_election_hash :: !Hash } deriving (Generic,NFData) deriving instance Reifies c FFC => ToJSON (Ballot c) -deriving instance Reifies c FFC => FromJSON (Ballot c) +instance Reifies c FFC => FromJSON (Ballot c) where + parseJSON = JSON.withObject "Ballot" $ \o -> do + ballot_answers <- o .: "answers" + ballot_signature <- o .:? "signature" + ballot_election_uuid <- o .: "election_uuid" + ballot_election_hash <- o .: "election_hash" + return Ballot{..} -- | @('encryptBallot' elec ('Just' ballotSecKey) opinionsByQuest)@ -- returns a 'Ballot' signed by 'secKey' (the voter's secret key) @@ -616,7 +645,13 @@ , signature_proof :: !(Proof c) } deriving (Generic,NFData) deriving instance Reifies c FFC => ToJSON (Signature c) -deriving instance Reifies c FFC => FromJSON (Signature c) +instance Reifies c FFC => FromJSON (Signature c) where + parseJSON = JSON.withObject "Signature" $ \o -> do + signature_publicKey <- o .: "public_key" + proof_challenge <- o .: "challenge" + proof_response <- o .: "response" + let signature_proof = Proof{..} + return Signature{..} -- *** Hashing diff --git a/src/Voting/Protocol/FFC.hs b/src/Voting/Protocol/FFC.hs --- a/src/Voting/Protocol/FFC.hs +++ b/src/Voting/Protocol/FFC.hs @@ -16,11 +16,8 @@ ) where import Control.Arrow (first) -import Control.Applicative (Applicative(..)) import Control.DeepSeq (NFData) import Control.Monad (Monad(..), unless) -import Control.Monad.Trans.Reader (ReaderT(..), asks) -import Control.Monad.Trans.Class (MonadTrans(..)) import Data.Aeson (ToJSON(..),FromJSON(..),(.:),(.:?),(.=)) import Data.Bits import Data.Bool @@ -52,6 +49,9 @@ import qualified Data.Char as Char import qualified Data.List as List import qualified Data.Text as Text +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Builder as TLB +import qualified Data.Text.Lazy.Builder.Int as TLB import qualified Prelude as Num import qualified System.Random as Random @@ -160,6 +160,14 @@ , ffc_groupOrder = 78571733251071885079927659812671450121821421258408794611510081919805623223441 } +{- +data WithFFC t = forall c. Reifies c FFC => WithFFC (t c) + +reifyFFC :: WithFFC t -> (forall c. Reifies c FFC => t c -> k) -> k +Coercible +reifyFFC (WithFFC ffc t) k = reify ffc $ \(_::Proxy c) -> k @c +-} + -- * Type 'F' -- | The type of the elements of a Finite Prime Field. -- @@ -197,7 +205,7 @@ , Just x <- readMaybe (Text.unpack s) , x < fieldCharac @c = return (F x) - parseJSON json = JSON.typeMismatch "F" json + parseJSON json = JSON.typeMismatch "FieldElement" json instance Reifies c FFC => FromNatural (F c) where fromNatural i = F $ abs $ i `mod` fieldCharac @c where @@ -288,7 +296,7 @@ , r <- G (F x) , r ^ E (groupOrder @c) == one = return r - parseJSON json = JSON.typeMismatch "G" json + parseJSON json = JSON.typeMismatch "GroupElement" json instance Reifies c FFC => FromNatural (G c) where fromNatural = G . fromNatural instance ToNatural (G c) where @@ -317,7 +325,7 @@ where go g = g : go (g * groupGen @c) -- | @('hash' bs gs)@ returns as a number in 'E' --- the SHA256 of the given 'BS.ByteString' 'bs' +-- the 'Crypto.SHA256' hash of the given 'BS.ByteString' 'bs' -- prefixing the decimal representation of given subgroup elements 'gs', -- with a comma (",") intercalated between them. -- @@ -332,11 +340,32 @@ let s = bs <> BS.intercalate (fromString ",") (bytesNat <$> gs) let h = Crypto.hashWith Crypto.SHA256 s fromNatural $ - BS.foldl' -- NOTE: interpret the SHA256 as a big-endian number. - (\acc b -> acc`shiftL`8 + fromIntegral b) - (0::Natural) - (ByteArray.convert h) + decodeBigEndian $ ByteArray.convert h +-- | @('hexHash' bs)@ returns the 'Crypto.SHA256' hash +-- of the given 'BS.ByteString' 'bs', escaped in hexadecimal +-- into a 'Text' of 32 lowercase characters. +-- +-- Used (in retro-dependencies of this library) to hash +-- the 'PublicKey' of a voter or a trustee. +hexHash :: BS.ByteString -> Text +hexHash bs = + let h = Crypto.hashWith Crypto.SHA256 bs in + let n = decodeBigEndian $ ByteArray.convert h in + -- NOTE: always set the 256 bit then remove it + -- to always have leading zeros, + -- and thus always 64 characters wide hashes. + TL.toStrict $ + TL.tail $ TLB.toLazyText $ TLB.hexadecimal $ + setBit n 256 + +-- | @('decodeBigEndian' bs)@ interpret @bs@ as big-endian number. +decodeBigEndian :: BS.ByteString -> Natural +decodeBigEndian = + BS.foldl' + (\acc b -> acc`shiftL`8 + fromIntegral b) + (0::Natural) + -- * Type 'E' -- | An exponent of a (necessarily cyclic) subgroup of a Finite Prime Field. -- The value is always in @[0..'groupOrder'-1]@. @@ -344,7 +373,7 @@ deriving (Eq,Ord,Show) deriving newtype NFData instance ToJSON (E c) where - toJSON (E x) = JSON.toJSON x + toJSON (E x) = JSON.toJSON (show x) instance Reifies c FFC => FromJSON (E c) where parseJSON (JSON.String s) | Just (c0,_) <- Text.uncons s @@ -353,7 +382,7 @@ , Just x <- readMaybe (Text.unpack s) , x < groupOrder @c = return (E x) - parseJSON json = JSON.typeMismatch "E" json + parseJSON json = JSON.typeMismatch "Exponent" json instance Reifies c FFC => FromNatural (E c) where fromNatural i = diff --git a/src/Voting/Protocol/Tally.hs b/src/Voting/Protocol/Tally.hs --- a/src/Voting/Protocol/Tally.hs +++ b/src/Voting/Protocol/Tally.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE UndecidableInstances #-} -- for Reifies instances module Voting.Protocol.Tally where @@ -7,17 +8,19 @@ import Control.DeepSeq (NFData) import Control.Monad (Monad(..), mapM, unless) import Control.Monad.Trans.Except (Except, ExceptT, throwE) -import Data.Aeson (ToJSON(..),FromJSON(..)) +import Data.Aeson (ToJSON(..),FromJSON(..),(.:),(.=)) import Data.Eq (Eq(..)) -import Data.Function (($)) +import Data.Function (($), (.)) import Data.Functor ((<$>)) import Data.Maybe (maybe) import Data.Semigroup (Semigroup(..)) -import Data.Tuple (fst) +import Data.Tuple (fst, snd) import GHC.Generics (Generic) import Numeric.Natural (Natural) -import Prelude (fromIntegral) import Text.Show (Show(..)) +import qualified Data.Aeson as JSON +import qualified Data.Aeson.Types as JSON +import qualified Data.Aeson.Encoding as JSON import qualified Control.Monad.Trans.State.Strict as S import qualified Data.ByteString as BS import qualified Data.List as List @@ -55,15 +58,22 @@ -- returns the sum of the 'Encryption's of the given @ballots@, -- along with the number of 'Ballot's. encryptedTally :: Reifies c FFC => [Ballot c] -> (EncryptedTally c, Natural) -encryptedTally ballots = - ( List.foldr (\Ballot{..} -> - List.zipWith (\Answer{..} -> - List.zipWith (+) - (fst <$> answer_opinions)) - ballot_answers) - (List.repeat (List.repeat zero)) - ballots - , fromIntegral $ List.length ballots +encryptedTally = List.foldr insertEncryptedTally emptyEncryptedTally + +-- | The initial 'EncryptedTally' which tallies no 'Ballot'. +emptyEncryptedTally :: Reifies c FFC => (EncryptedTally c, Natural) +emptyEncryptedTally = (List.repeat (List.repeat zero), 0) + +-- | @('insertEncryptedTally' ballot encTally)@ +-- returns the 'EncryptedTally' adding the votes of the given @(ballot)@ +-- to those of the given @(encTally)@. +insertEncryptedTally :: Reifies c FFC => Ballot c -> (EncryptedTally c, Natural) -> (EncryptedTally c, Natural) +insertEncryptedTally Ballot{..} (encTally, numBallots) = + ( List.zipWith + (\Answer{..} -> List.zipWith (+) (fst <$> answer_opinions)) + ballot_answers + encTally + , numBallots+1 ) -- ** Type 'DecryptionShareCombinator' @@ -114,7 +124,34 @@ -- ** Type 'DecryptionShare' -- | A decryption share is a 'DecryptionFactor' and a decryption 'Proof', by choice by 'Question'. -- Computed by a trustee in 'proveDecryptionShare'. -type DecryptionShare c = [[(DecryptionFactor c, Proof c)]] +newtype DecryptionShare c = DecryptionShare + { unDecryptionShare :: [[(DecryptionFactor c, Proof c)]] } + deriving (Eq,Show,Generic) +deriving newtype instance NFData (DecryptionShare c) +instance ToJSON (DecryptionShare c) where + toJSON (DecryptionShare decByChoiceByQuest) = + JSON.object + [ "decryption_factors" .= + toJSONList (((toJSON . fst) <$>) <$> decByChoiceByQuest) + , "decryption_proofs" .= + toJSONList (((toJSON . snd) <$>) <$> decByChoiceByQuest) + ] + toEncoding (DecryptionShare decByChoiceByQuest) = + JSON.pairs $ + JSON.pair "decryption_factors" + (JSON.list (JSON.list (toEncoding . fst)) decByChoiceByQuest) <> + JSON.pair "decryption_proofs" + (JSON.list (JSON.list (toEncoding . snd)) decByChoiceByQuest) +instance Reifies c FFC => FromJSON (DecryptionShare c) where + parseJSON = JSON.withObject "DecryptionShare" $ \o -> do + decFactors <- o .: "decryption_factors" + decProofs <- o .: "decryption_proofs" + let err msg = JSON.typeMismatch ("DecryptionShare: "<>msg) (JSON.Object o) + DecryptionShare + <$> isoZipWithM (err "inconsistent number of questions") + (isoZipWithM (err "inconsistent number of choices") + (\a b -> return (a, b))) + decFactors decProofs -- *** Type 'DecryptionFactor' -- | @'encryption_nonce' '^'trusteeSecKey@ @@ -125,6 +162,7 @@ Monad m => Reifies c FFC => RandomGen r => EncryptedTally c -> SecretKey c -> S.StateT r m (DecryptionShare c) proveDecryptionShare encByChoiceByQuest trusteeSecKey = + (DecryptionShare <$>) $ (proveDecryptionFactor trusteeSecKey `mapM`) `mapM` encByChoiceByQuest proveDecryptionFactor :: @@ -163,7 +201,7 @@ Monad m => Reifies c FFC => EncryptedTally c -> PublicKey c -> DecryptionShare c -> ExceptT ErrorTally m () -verifyDecryptionShare encByChoiceByQuest trusteePubKey = +verifyDecryptionShare encByChoiceByQuest trusteePubKey (DecryptionShare decShare) = let zkp = decryptionShareStatement trusteePubKey in isoZipWithM_ (throwE ErrorTally_NumberOfQuestions) (isoZipWithM_ (throwE ErrorTally_NumberOfChoices) $ @@ -173,6 +211,7 @@ , commit proof encryption_nonce decFactor ]) $ throwE ErrorTally_WrongProof) encByChoiceByQuest + decShare verifyDecryptionShareByTrustee :: Monad m => Reifies c FFC => diff --git a/src/Voting/Protocol/Trustee/Indispensable.hs b/src/Voting/Protocol/Trustee/Indispensable.hs --- a/src/Voting/Protocol/Trustee/Indispensable.hs +++ b/src/Voting/Protocol/Trustee/Indispensable.hs @@ -7,7 +7,7 @@ import Control.DeepSeq (NFData) import Control.Monad (Monad(..), foldM, unless) import Control.Monad.Trans.Except (ExceptT(..), throwE) -import Data.Aeson (ToJSON(..),FromJSON(..)) +import Data.Aeson (ToJSON(..),FromJSON(..),(.:),(.=)) import Data.Eq (Eq(..)) import Data.Function (($)) import Data.Functor ((<$>)) @@ -17,6 +17,7 @@ import GHC.Generics (Generic) import Text.Show (Show(..)) import qualified Control.Monad.Trans.State.Strict as S +import qualified Data.Aeson as JSON import qualified Data.ByteString as BS import qualified Data.List as List @@ -44,8 +45,22 @@ -- Which is done in 'proveIndispensableTrusteePublicKey' -- and 'verifyIndispensableTrusteePublicKey'. } deriving (Eq,Show,Generic,NFData) -deriving instance Reifies c FFC => ToJSON (TrusteePublicKey c) -deriving instance Reifies c FFC => FromJSON (TrusteePublicKey c) +instance ToJSON (TrusteePublicKey c) where + toJSON TrusteePublicKey{..} = + JSON.object + [ "pok" .= trustee_SecretKeyProof + , "public_key" .= trustee_PublicKey + ] + toEncoding TrusteePublicKey{..} = + JSON.pairs + ( "pok" .= trustee_SecretKeyProof + <> "public_key" .= trustee_PublicKey + ) +instance Reifies c FFC => FromJSON (TrusteePublicKey c) where + parseJSON = JSON.withObject "TrusteePublicKey" $ \o -> do + trustee_PublicKey <- o .: "public_key" + trustee_SecretKeyProof <- o .: "pok" + return TrusteePublicKey{..} -- ** Type 'ErrorTrusteePublicKey' data ErrorTrusteePublicKey @@ -113,10 +128,10 @@ encByChoiceByQuest pubKeyByTrustee decByChoiceByQuestByTrustee - (dec0,decs) <- + (DecryptionShare dec0,decs) <- maybe (throwE ErrorTally_NumberOfTrustees) return $ List.uncons decByChoiceByQuestByTrustee foldM (isoZipWithM (throwE ErrorTally_NumberOfQuestions) (maybe (throwE ErrorTally_NumberOfChoices) return `o2` isoZipWith (\a (decFactor, _proof) -> a * decFactor))) - ((fst <$>) <$> dec0) decs + ((fst <$>) <$> dec0) (unDecryptionShare <$> decs)