hjugement-protocol 0.0.1.20190623 → 0.0.4.20190711

raw patch · 6 files changed

+161/−50 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• hjugement-protocol.cabal +1/−1
• src/Voting/Protocol/Credential.hs +2/−9
• src/Voting/Protocol/Election.hs +43/−8
• src/Voting/Protocol/FFC.hs +41/−12
• src/Voting/Protocol/Tally.hs +54/−15
• src/Voting/Protocol/Trustee/Indispensable.hs +20/−5

@@ -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:

@@ -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

@@ -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 

@@ -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 =

@@ -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 =>

@@ -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)