hjugement-protocol 0.0.0.20190428 → 0.0.0.20190501

raw patch · 6 files changed

+310/−198 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Protocol/Arithmetic.hs +64/−42
• Protocol/Credential.hs +2/−3
• Protocol/Election.hs +230/−144
• hjugement-protocol.cabal +6/−3
• test/HUnit/Arithmetic.hs +6/−4
• test/HUnit/Election.hs +2/−2

@@ -1,13 +1,17 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-module Protocol.Arithmetic where+module Protocol.Arithmetic+ ( module Protocol.Arithmetic+ , Natural+ ) where  import Control.Arrow (first) import Control.Monad (Monad(..)) import Data.Bits import Data.Bool import Data.Eq (Eq(..))-import Data.Foldable (Foldable, foldl', foldMap)+import Data.Foldable (Foldable, foldl') import Data.Function (($), (.))+import Data.Functor ((<$>)) import Data.Int (Int) import Data.Maybe (Maybe(..)) import Data.Ord (Ord(..))@@ -21,7 +25,7 @@ import qualified Data.ByteArray as ByteArray import qualified Data.ByteString as BS import qualified Data.List as List-import qualified Prelude as N+import qualified Prelude as Num import qualified System.Random as Random  -- * Type 'F'@@ -51,17 +55,19 @@ newtype F p = F { unF :: Natural }  deriving (Eq,Ord,Show) -inF :: forall p i. PrimeField p => Integral i => i -> F p-inF i = F (abs (fromIntegral i `mod` fieldCharac @p))-	where abs x | x < 0 = x + fieldCharac @p-	            | otherwise = x+instance PrimeField p => FromNatural (F p) where+	fromNatural i = F (abs (i `mod` fieldCharac @p))+		where abs x | x < 0 = x + fieldCharac @p+		            | otherwise = x+instance ToNatural (F p) where+	nat = unF  instance PrimeField p => Additive (F p) where 	zero = F 0 	F x + F y = F ((x + y) `mod` fieldCharac @p) instance PrimeField p => Negable (F p) where 	neg (F x) | x == 0 = zero-	          | otherwise = F (fromIntegral (N.negate (toInteger x) + toInteger (fieldCharac @p)))+	          | otherwise = F (fromIntegral (Num.negate (toInteger x) + toInteger (fieldCharac @p))) instance PrimeField p => Multiplicative (F p) where 	one = F 1 	-- | Because 'fieldCharac' is prime,@@ -92,13 +98,13 @@ 	sum = foldl' (+) zero instance Additive Natural where 	zero = 0-	(+)  = (N.+)+	(+)  = (Num.+) instance Additive Integer where 	zero = 0-	(+)  = (N.+)+	(+)  = (Num.+) instance Additive Int where 	zero = 0-	(+)  = (N.+)+	(+)  = (Num.+)  -- *** Class 'Negable' class Additive a => Negable a where@@ -106,9 +112,9 @@ 	(-) :: a -> a -> a; infixl 6 - 	x-y = x + neg y instance Negable Integer where-	neg  = N.negate+	neg  = Num.negate instance Negable Int where-	neg  = N.negate+	neg  = Num.negate  -- ** Class 'Multiplicative' class Multiplicative a where@@ -116,13 +122,13 @@ 	(*) :: a -> a -> a; infixl 7 * instance Multiplicative Natural where 	one = 1-	(*) = (N.*)+	(*) = (Num.*) instance Multiplicative Integer where 	one = 1-	(*) = (N.*)+	(*) = (Num.*) instance Multiplicative Int where 	one = 1-	(*) = (N.*)+	(*) = (Num.*)  -- ** Class 'Invertible' class Multiplicative a => Invertible a where@@ -135,10 +141,10 @@ newtype G q = G { unG :: F (P q) }  deriving (Eq,Ord,Show) --- | @('natG' g)@ returns the element of the 'SubGroup' 'g'--- as an 'Natural' within @[0..'fieldCharac'-1]@.-natG :: SubGroup q => G q -> Natural-natG = unF . unG+instance PrimeField (P q) => FromNatural (G q) where+	fromNatural = G . fromNatural+instance ToNatural (G q) where+	nat = unF . unG  instance (SubGroup q, Multiplicative (F (P q))) => Multiplicative (G q) where 	one = G one@@ -148,7 +154,7 @@ 	inv = (^ E (neg one + groupOrder @q))  -- ** Class 'SubGroup'--- | A 'SubGroup' of a 'PrimeField'.+-- | A 'SubGroup' of a 'Multiplicative' group of a 'PrimeField'. -- Used for signing (Schnorr) and encrypting (ElGamal). class  ( PrimeField (P q)@@ -165,8 +171,7 @@ 	-- | The order of the 'SubGroup'. 	-- 	-- WARNING: 'groupOrder' MUST be a prime number dividing @('fieldCharac'-1)@-	-- to ensure that ensures that ElGamal is secure in terms-	-- of the DDH assumption.+	-- to ensure that ElGamal is secure in terms of the DDH assumption. 	groupOrder :: F (P q) 	 	-- | 'groupGenInverses' returns the infinite list@@ -175,29 +180,33 @@ 	-- but by computing each value from the previous one. 	-- 	-- NOTE: 'groupGenInverses' is in the 'SubGroup' class in order to keep-	-- computed terms in memory accross calls to 'groupGenInverses'.+	-- computed terms in memory across calls to 'groupGenInverses'. 	---	-- Used by 'validableEncryption'.+	-- Used by 'intervalDisjunctions'. 	groupGenInverses :: [G q] 	groupGenInverses = go one 		where 		go g = g : go (g * invGen) 		invGen = inv groupGen --- | @('hash' prefix gs)@ returns as a number in @('F' p)@--- the SHA256 of the given 'prefix' prefixing the decimal representation--- of given 'SubGroup' elements 'gs', each one postfixed with a comma (",").+-- | @('hash' bs gs)@ returns as a number in 'E'+-- the SHA256 of the given 'BS.ByteString' 'bs'+-- prefixing the decimal representation of given 'SubGroup' elements 'gs',+-- with a comma (",") intercalated between them. ----- Used by 'proveEncryption' and 'validateEncryption',--- where the 'prefix' contains the 'statement' to be proven,+-- NOTE: to avoid any collision when the 'hash' function is used in different contexts,+-- a message 'gs' is actually prefixed by a 'bs' indicating the context.+--+-- Used by 'proveEncryption' and 'verifyEncryption',+-- where the 'bs' usually contains the 'statement' to be proven, -- and the 'gs' contains the 'commitments'. hash ::  SubGroup q =>  BS.ByteString -> [G q] -> E q-hash prefix gs =-	let s = prefix <> foldMap (\(G (F i)) -> fromString (show i) <> fromString ",") gs in+hash bs gs =+	let s = bs <> BS.intercalate (fromString ",") (bytesNat <$> gs) in 	let h = ByteArray.convert (Crypto.hashWith Crypto.SHA256 s) in-	inE (BS.foldl' (\acc b -> acc`shiftL`3 + fromIntegral b) (0::Natural) h)+	fromNatural (BS.foldl' (\acc b -> acc`shiftL`3 + fromIntegral b) (0::Natural) h)  -- * Type 'E' -- | An exponent of a (necessarily cyclic) 'SubGroup' of a 'PrimeField'.@@ -205,13 +214,12 @@ newtype E q = E { unE :: F (P q) }  deriving (Eq,Ord,Show) -inE :: forall q i. SubGroup q => Integral i => i -> E q-inE i = E (F (abs (fromIntegral i `mod` unF (groupOrder @q))))-	where abs x | x < 0 = x + unF (groupOrder @q)-	            | otherwise = x--natE :: forall q. SubGroup q => E q -> Natural-natE = unF . unE+instance SubGroup q => FromNatural (E q) where+	fromNatural i = E (F (abs (i `mod` unF (groupOrder @q))))+		where abs x | x < 0 = x + unF (groupOrder @q)+		            | otherwise = x+instance ToNatural (E q) where+	nat = unF . unE  instance (SubGroup q, Additive (F (P q))) => Additive (E q) where 	zero = E zero@@ -233,8 +241,8 @@ 		first (E . F . fromIntegral) . 		Random.randomR (0, toInteger (unF (groupOrder @q)) - 1) instance SubGroup q => Enum (E q) where-	toEnum = inE-	fromEnum = fromIntegral . natE+	toEnum = fromNatural . fromIntegral+	fromEnum = fromIntegral . nat 	enumFromTo lo hi = List.unfoldr 	 (\i -> if i<=hi then Just (i, i+one) else Nothing) lo @@ -302,3 +310,17 @@ 	type P BeleniosParams = BeleniosParams 	groupGen = G (F 2402352677501852209227687703532399932712287657378364916510075318787663274146353219320285676155269678799694668298749389095083896573425601900601068477164491735474137283104610458681314511781646755400527402889846139864532661215055797097162016168270312886432456663834863635782106154918419982534315189740658186868651151358576410138882215396016043228843603930989333662772848406593138406010231675095763777982665103606822406635076697764025346253773085133173495194248967754052573659049492477631475991575198775177711481490920456600205478127054728238140972518639858334115700568353695553423781475582491896050296680037745308460627) 	groupOrder = F 78571733251071885079927659812671450121821421258408794611510081919805623223441++-- * Conversions++-- ** Class 'FromNatural'+class FromNatural a where+	fromNatural :: Natural -> a++-- ** Class 'ToNatural'+class ToNatural a where+	nat :: a -> Natural++-- | @('bytesNat' x)@ returns the serialization of 'x'.+bytesNat :: ToNatural n => n -> BS.ByteString+bytesNat = fromString . show . nat

@@ -97,8 +97,7 @@  S.StateT r m UUID randomUUID = do 	rs <- replicateM tokenLength (randomR (fromIntegral tokenBase))-	let cs = List.foldl' (\ds d -> charOfDigit d : ds) [] rs-	return $ UUID $ Text.reverse $ Text.pack cs+	return $ UUID $ Text.pack $ charOfDigit <$> rs 	where 	charOfDigit = (credentialAlphabet List.!!) @@ -110,7 +109,7 @@ -- using 'Crypto.fastPBKDF2_SHA256'. secretKey :: SubGroup q => UUID -> Credential -> SecretKey q secretKey (UUID uuid) (Credential cred) =-	inE $ BS.foldl'+	fromNatural $ BS.foldl' 	 (\acc b -> acc`shiftL`3 + fromIntegral b) 	 (0::Natural) 	 (ByteArray.convert deriv)

@@ -3,7 +3,7 @@ {-# LANGUAGE OverloadedStrings #-} module Protocol.Election where -import Control.Monad (Monad(..), mapM, zipWithM)+import Control.Monad (Monad(..), join, mapM, zipWithM) import Control.Monad.Morph (MFunctor(..)) import Control.Monad.Trans.Class (MonadTrans(..)) import Data.Bool@@ -16,13 +16,12 @@ import Data.Maybe (Maybe(..), fromMaybe) import Data.Ord (Ord(..)) import Data.Semigroup (Semigroup(..))-import Data.String (IsString(..)) import Data.Text (Text) import Data.Traversable (Traversable(..))-import Data.Tuple (fst, snd)+import Data.Tuple (fst, snd, uncurry) import GHC.Natural (minusNaturalMaybe) import Numeric.Natural (Natural)-import Prelude (error, fromIntegral)+import Prelude (fromIntegral) import Text.Show (Show(..)) import qualified Control.Monad.Trans.Except as Exn import qualified Control.Monad.Trans.State.Strict as S@@ -38,13 +37,18 @@ -- -- Because ('groupGen' '^'encNonce '^'secKey '==' 'groupGen' '^'secKey '^'encNonce), -- knowing @secKey@, one can divide 'encryption_vault' by @('encryption_nonce' '^'secKey)@--- to decipher @('groupGen' '^'clear)@, then @clear@ must be small to be decryptable,--- because it is encrypted as a power of 'groupGen' to enable the additive homomorphism.+-- to decipher @('groupGen' '^'clear)@, then the @clear@ text must be small to be decryptable,+-- because it is encrypted as a power of 'groupGen' (hence the "-like" in "ElGamal-like")+-- to enable the additive homomorphism.+--+-- NOTE: Since @('encryption_vault' '*' 'encryption_nonce' '==' 'encryption_nonce' '^' (secKey '+' clear))@,+-- then: @(logBase 'encryption_nonce' ('encryption_vault' '*' 'encryption_nonce') '==' secKey '+' clear)@. data Encryption q = Encryption  { encryption_nonce :: G q-   -- ^ Public part of the random 'encNonce': @('groupGen' '^'encNonce)@+   -- ^ Public part of the randomness 'encNonce' used to 'encrypt' the 'clear' text,+   -- equal to @('groupGen' '^'encNonce)@  , encryption_vault :: G q-   -- ^ Encrypted clear: @('pubKey' '^'r '*' 'groupGen' '^'clear)@+   -- ^ Encrypted 'clear' text, equal to @('pubKey' '^'r '*' 'groupGen' '^'clear)@  } deriving (Eq,Show)  -- | Additive homomorphism.@@ -62,7 +66,7 @@ -- -- WARNING: the secret encryption nonce (@encNonce@) -- is returned alongside the 'Encryption'--- in order to prove the validity of the encrypted clear in 'prove',+-- in order to 'prove' the validity of the encrypted 'clear' text in 'proveEncryption', -- but this secret @encNonce@ MUST be forgotten after that, -- as it may be used to decipher the 'Encryption' -- without the secret key associated with 'pubKey'.@@ -72,46 +76,65 @@  S.StateT r m (EncryptionNonce q, Encryption q) encrypt pubKey clear = do 	encNonce <- random-	-- NOTE: preserve the 'encNonce' for 'prove'.+	-- NOTE: preserve the 'encNonce' for 'prove' in 'proveEncryption'. 	return $ (encNonce,) 		Encryption 		 { encryption_nonce = groupGen^encNonce 		 , encryption_vault = pubKey  ^encNonce * groupGen^clear-		 -- NOTE: 'clear' is put as exponent in order-		 -- to make an additive homomorphism-		 -- instead of a multiplicative homomorphism.-		 -- log (a*b) = log a + log b 		 }  -- * Type 'Proof' -- | 'Proof' of knowledge of a discrete logarithm:--- @secret == logBase base (base^secret)@.------ NOTE: Since @(pubKey == 'groupGen' '^'secKey)@, then:--- @(logBase 'encryption_nonce' ('encryption_vault' '*' 'encryption_nonce') '==' secKey '+' clear)@.+-- @(secret == logBase base (base^secret))@. data Proof q = Proof  { proof_challenge :: Challenge q    -- ^ 'Challenge' sent by the verifier to the prover    -- to ensure that the prover really has knowledge    -- of the secret and is not replaying.-   -- Actually, 'proof_challenge' is not sent in a 'prove',+   -- Actually, 'proof_challenge' is not sent to the prover,    -- but derived from the prover's 'Commitment's and statements-   -- with a collision resistant hash.+   -- with a collision resistant 'hash'.+   -- Hence the prover cannot chose the 'proof_challenge' to his/her liking.  , proof_response :: E q-   -- ^ Response sent by the prover to the verifier.-   -- Usually: @nonce '+' sec '*' 'proof_challenge'@.+   -- ^ A discrete logarithm sent by the prover to the verifier,+   -- as a response to 'proof_challenge'.    ---   -- To be computed efficiently, it requires @sec@:-   -- either the @secKey@ (in 'signature_proof')-   -- or the @encNonce@ (in 'prove').+   -- If the verifier observes that @('proof_challenge' '==' 'hash' statement [commitment])@+   -- where:+   --+   -- * @statement@ is a serialization of a tag, 'base' and 'basePowSec',+   -- * @(commitment '==' 'commit' proof base basePowSec '=='+   --   base '^' 'proof_response' '*' basePowSec '^' 'proof_challenge')@,+   -- * and @(basePowSec '==' base'^'sec)@,+   --+   -- then, with overwhelming probability due to the 'hash' function:+   -- @(commitment '==' base'^'nonce)@.+   -- Therefore by expanding 'commitment':+   -- @('proof_response' '==' logBase base (base'^'nonce) '-' logBase basePowSec (basePowSec '^' 'proof_challenge'))@,+   -- which means that the prover must have known 'nonce' and 'sec'+   -- to compute 'proof_response' efficiently with:+   -- @('proof_response' '==' nonce '-' sec '*' 'proof_challenge')@,+   --+   -- The 'nonce' is introduced to ensure each 'prove' does not reveal+   -- any information regarding the prover's secret 'sec',+   -- by being randomly chosen by the prover.  } deriving (Eq,Show) +-- ** Type 'ZKP'+-- | Zero-knowledge proof+--+-- DOC: Mihir Bellare and Phillip Rogaway. Random oracles are practical:+--      A paradigm for designing efficient protocols. In ACM-CCS’93, 1993.+--+-- DOC: Pierrick Gaudry. <https://hal.inria.fr/hal-01576379 Some ZK security proofs for Belenios>, 2017.+newtype ZKP = ZKP BS.ByteString+ -- ** Type 'Challenge' type Challenge = E  -- ** Type 'Oracle' -- An 'Oracle' returns the 'Challenge' of the 'Commitment's--- by hashing them (eventually with other 'Commitment's).+-- by 'hash'ing them (eventually with other 'Commitment's). -- -- Used in 'prove' it enables a Fiat-Shamir transformation -- of an /interactive zero-knowledge/ (IZK) proof@@ -119,35 +142,32 @@ -- That is to say that the verifier does not have -- to send a 'Challenge' to the prover. -- Indeed, the prover now handles the 'Challenge'--- which becomes a (collision resistant) hash+-- which becomes a (collision resistant) 'hash' -- of the prover's commitments (and statements to be a stronger proof). type Oracle list q = list (Commitment q) -> Challenge q --- | @('prove' sec commitments oracle)@+-- | @('prove' sec commitBases oracle)@ -- returns a 'Proof' that @sec@ is known. ----- The 'Oracle' is given the 'commitments'+-- The 'Oracle' is given the 'commitBases' -- raised to the power of the secret nonce of the 'Proof',--- as those are the 'commitments' that the verifier will obtain+-- as those are the 'commitBases' that the verifier will obtain -- when composing the 'proof_challenge' and 'proof_response' together--- (in 'encryptionCommitments').+-- (in 'commit'). -- -- NOTE: 'sec' is @secKey@ in 'signature_proof' or @encNonce@ in 'proveEncryption'. ----- NOTE: The 'commitments' are @['groupGen']@ in 'signature_proof'--- or @['groupGen', 'pubKey']@ in 'proveEncryption'.--- -- WARNING: for 'prove' to be a so-called /strong Fiat-Shamir transformation/ (not a weak):--- the statement must be included in the hash (not only the commitments).+-- the statement must be included in the 'hash' (not only the commitments). -- -- NOTE: a 'random' @nonce@ is used to ensure each 'prove' -- does not reveal any information regarding the secret 'sec'. prove ::  Monad m => RandomGen r => SubGroup q => Functor list =>  E q -> list (Commitment q) -> Oracle list q -> S.StateT r m (Proof q)-prove sec commitments oracle = do+prove sec commitBases oracle = do 	nonce <- random-	let proof_challenge = oracle $ (^ nonce) <$> commitments+	let proof_challenge = oracle $ (^ nonce) <$> commitBases 	return Proof 	 { proof_challenge 	 , proof_response = nonce - sec*proof_challenge@@ -156,24 +176,19 @@ -- ** Type 'Commitment' type Commitment = G --- | @('commit' proof x y)@ returns a 'Commitment'+-- | @('commit' proof base basePowSec)@ returns a 'Commitment' -- from the given 'Proof' with the knowledge of the verifier.------ NOTE: Contrary to Helios-C specifications,--- @('*')@ is used instead of @('/')@--- to avoid the performance cost of a modular exponentiation--- @('^' ('groupOrder' '-' 'one'))@,--- this is compensated by using @('-')@ instead of @('+')@ in 'prove'. commit :: SubGroup q => Proof q -> G q -> G q -> Commitment q-commit Proof{..} x y = x^proof_response * y^proof_challenge+commit Proof{..} base basePowSec =+	base^proof_response *+	basePowSec^proof_challenge+  -- NOTE: Contrary to some textbook presentations,+  -- @('*')@ is used instead of @('/')@ to avoid the performance cost+  -- of a modular exponentiation @('^' ('groupOrder' '-' 'one'))@,+  -- this is compensated by using @('-')@ instead of @('+')@ in 'prove'. {-# INLINE commit #-} --- ** Type 'Opinion'--- | Index of a 'Disjunction' within a list of them.--- It is encrypted as an 'E'xponent by 'encrypt'.-type Opinion = E---- ** Type 'Disjunction'+-- * Type 'Disjunction' -- | A 'Disjunction' is an 'inv'ersed @('groupGen' '^'opinion)@ -- it's used in 'proveEncryption' to generate a 'Proof' -- that an 'encryption_vault' contains a given @('groupGen' '^'opinion)@,@@ -184,33 +199,35 @@  intervalDisjunctions :: SubGroup q => Opinion q -> Opinion q -> [Disjunction q] intervalDisjunctions mini maxi =-	List.genericTake (fromMaybe 0 $ (natE maxi + 1)`minusNaturalMaybe`natE mini) $-	List.genericDrop (natE mini) $+	List.genericTake (fromMaybe 0 $ (nat maxi + 1)`minusNaturalMaybe`nat mini) $+	List.genericDrop (nat mini) $ 	groupGenInverses +-- ** Type 'Opinion'+-- | Index of a 'Disjunction' within a list of them.+-- It is encrypted as an 'E'xponent by 'encrypt'.+type Opinion = E+ -- ** Type 'DisjProof' -- | A list of 'Proof's to prove that the 'Opinion' within an 'Encryption' -- is indexing a 'Disjunction' within a list of them,--- without knowing which 'Opinion' it is.+-- without revealing which 'Opinion' it is. newtype DisjProof q = DisjProof [Proof q]  deriving (Eq,Show) --- | @('proveEncryption' pubKey zkp disjs opin (encNonce, enc))@+-- | @('proveEncryption' elecPubKey voterZKP (prevDisjs,nextDisjs) (encNonce,enc))@ -- returns a 'DisjProof' that 'enc' 'encrypt's--- one of the 'Disjunction's within 'disjs',--- without revealing which one it is.+-- the 'Disjunction's between 'prevDisjs' and 'nextDisjs'. -- -- A /NIZK Disjunctive Chaum Pedersen Logarithm Equality/ is used. proveEncryption ::  forall m r q.  Monad m => RandomGen r => SubGroup q =>  PublicKey q -> ZKP ->- [Disjunction q] -> Opinion q ->+ ([Disjunction q],[Disjunction q]) ->  (EncryptionNonce q, Encryption q) ->- S.StateT r (Exn.ExceptT ErrorProove m) (DisjProof q)-proveEncryption pubKey zkp disjs opinion (encNonce, enc)- | (prevDisjs, _indexedDisj:nextDisjs) <--   List.genericSplitAt (natE opinion) disjs = do+ S.StateT r m (DisjProof q)+proveEncryption elecPubKey voterZKP (prevDisjs,nextDisjs) (encNonce,enc) = do 	-- Fake proofs for all values except the correct one. 	prevFakes <- fakeProof `mapM` prevDisjs 	nextFakes <- fakeProof `mapM` nextDisjs@@ -219,21 +236,18 @@ 	let challengeSum = 		sum (proof_challenge <$> prevProofs) + 		sum (proof_challenge <$> nextProofs)-	correctProof <- prove encNonce [groupGen, pubKey] $+	let statement = encryptionStatement voterZKP enc+	correctProof <- prove encNonce [groupGen, elecPubKey] $ 	 -- 'Oracle' 	 \correctCommitments -> 		let commitments = 			foldMap snd prevFakes <> 			correctCommitments <> 			foldMap snd nextFakes in-		hash (encryptionStatement zkp enc) commitments - challengeSum+		hash statement commitments - challengeSum 	return $ DisjProof $ prevProofs <> (correctProof : nextProofs)- | otherwise = lift $ Exn.throwE $-	ErrorProove_InvalidOpinion-	 (fromIntegral $ List.length disjs)-	 (natE opinion) 	where-	fakeProof :: Disjunction q -> S.StateT r (Exn.ExceptT ErrorProove m) (Proof q, [Commitment q])+	fakeProof :: Disjunction q -> S.StateT r m (Proof q, [Commitment q]) 	fakeProof disj = do 		-- Returns 'Commitment's verifiables by the verifier, 		-- but computed from random 'proof_challenge' and 'proof_response'@@ -241,7 +255,7 @@ 		proof_challenge <- random 		proof_response  <- random 		let proof = Proof{..}-		return (proof, encryptionCommitments pubKey enc (disj, proof))+		return (proof, encryptionCommitments elecPubKey enc (disj, proof))  verifyEncryption ::  Monad m =>@@ -250,23 +264,30 @@  [Disjunction q] ->  (Encryption q, DisjProof q) ->  Exn.ExceptT ErrorValidateEncryption m Bool-verifyEncryption pubKey zkp disjs (enc, DisjProof proofs)+verifyEncryption elecPubKey voterZKP disjs (enc, DisjProof proofs)  | List.length proofs /= List.length disjs = 	Exn.throwE $ ErrorValidateEncryption_InvalidProofLength 	 (fromIntegral $ List.length proofs) 	 (fromIntegral $ List.length disjs)- | otherwise = return $ challengeSum == hash (encryptionStatement zkp enc) commitments+ | otherwise = return $ challengeSum == hash (encryptionStatement voterZKP enc) commitments 	where 	challengeSum = sum (proof_challenge <$> proofs)-	commitments = foldMap (encryptionCommitments pubKey enc) (List.zip disjs proofs)+	commitments = foldMap+	 (encryptionCommitments elecPubKey enc)+	 (List.zip disjs proofs) +-- ** Hashing encryptionStatement :: SubGroup q => ZKP -> Encryption q -> BS.ByteString-encryptionStatement (ZKP zkp) Encryption{..} =-	"prove|"<>zkp<>"|"<>-	fromString (show (natG encryption_nonce))<>","<>-	fromString (show (natG encryption_vault))<>"|"+encryptionStatement (ZKP voterZKP) Encryption{..} =+	"prove|"<>voterZKP<>"|"+	 <> bytesNat encryption_nonce<>","+	 <> bytesNat encryption_vault<>"|"+	-- NOTE: the commitment base 'elecPubKey' is notably absent here+	-- despite it being used in 'encryptionCommitments',+	-- maybe this is not necessary because it is already known+	-- by every participant. --- | @('encryptionCommitments' pubKey enc (disj,proof))@+-- | @('encryptionCommitments' elecPubKey enc (disj,proof))@ -- returns the 'Commitment's with only the knowledge of the verifier. -- -- The 'Proof' comes from 'prove' of @fakeProof@ in 'proveEncryption'.@@ -274,25 +295,14 @@  SubGroup q =>  PublicKey q -> Encryption q ->  (Disjunction q, Proof q) -> [G q]-encryptionCommitments pubKey Encryption{..} (disj, proof) =+encryptionCommitments elecPubKey Encryption{..} (disj, proof) = 	[ commit proof groupGen encryption_nonce 	  -- == groupGen ^ nonce if 'Proof' comes from 'prove'-	, commit proof pubKey (encryption_vault*disj)-	  -- == pubKey ^ nonce if 'Proof' comes from 'prove'+	, commit proof elecPubKey (encryption_vault*disj)+	  -- == elecPubKey ^ nonce if 'Proof' comes from 'prove' 	  -- and 'encryption_vault' encrypts (- logBase groupGen disj). 	] --- ** Type 'ZKP'--- | Zero-knowledge proof-newtype ZKP = ZKP BS.ByteString---- ** Type 'ErrorProove'--- | Error raised by 'proveEncryption'.-data ErrorProove- =   ErrorProove_InvalidOpinion Natural Natural-     -- ^ When the opinion is not within the number of 'Disjunction's.- deriving (Eq,Show)- -- ** Type 'ErrorValidateEncryption' -- | Error raised by 'verifyEncryption'. data ErrorValidateEncryption@@ -321,18 +331,7 @@  -- , answer_blankProof ::  } deriving (Eq,Show) --- ** Type 'ErrorAnswer'--- | Error raised by 'encryptAnswer'.-data ErrorAnswer- =   ErrorAnswer_WrongNumberOfOpinions Natural Natural-     -- ^ When the number of opinions is different than-     -- the number of choices ('question_choices').- |   ErrorAnswer_WrongSumOfOpinions Natural Natural Natural-     -- ^ When the sum of opinions is not within the bounds-     -- of 'question_mini' and 'question_maxi'.- deriving (Eq,Show)---- | @('encryptAnswer' pubKey zkp quest opinions)@+-- | @('encryptAnswer' elecPubKey zkp quest opinions)@ -- returns an 'Answer' validable by 'verifyAnswer', -- unless an 'ErrorAnswer' is returned. encryptAnswer ::@@ -340,38 +339,38 @@  PublicKey q -> ZKP ->  Question q -> [Bool] ->  S.StateT r (Exn.ExceptT ErrorAnswer m) (Answer q)-encryptAnswer pubKey zkp Question{..} opinionsBools+encryptAnswer elecPubKey zkp Question{..} opinionsBools  | not (question_mini <= opinionsSum && opinionsSum <= question_maxi) = 	lift $ Exn.throwE $ 		ErrorAnswer_WrongSumOfOpinions-		 (natE opinionsSum)-		 (natE question_mini)-		 (natE question_maxi)+		 (nat opinionsSum)+		 (nat question_mini)+		 (nat question_maxi)  | List.length opinions /= List.length question_choices = 	lift $ Exn.throwE $ 		ErrorAnswer_WrongNumberOfOpinions 		 (fromIntegral $ List.length opinions) 		 (fromIntegral $ List.length question_choices)  | otherwise = do-	encryptions <- encrypt pubKey `mapM` opinions-	hoist (Exn.withExceptT (\case-		 ErrorProove_InvalidOpinion{} -> error "encryptAnswer: impossible happened"-	 )) $ do-		individualProofs <- zipWithM-		 (proveEncryption pubKey zkp booleanDisjunctions)-		 opinions encryptions-		sumProof <- proveEncryption pubKey zkp-		 (intervalDisjunctions question_mini question_maxi)-		 (opinionsSum - question_mini)-		 ( sum (fst <$> encryptions) -- NOTE: sum the 'encNonce's-		 , sum (snd <$> encryptions) -- NOTE: sum the 'Encryption's-		 )-		return $ Answer-		 { answer_opinions = List.zip-			 (snd <$> encryptions) -- NOTE: drop encNonce-			 individualProofs-		 , answer_sumProof = sumProof-		 }+	encryptions <- encrypt elecPubKey `mapM` opinions+	individualProofs <- zipWithM+	 (\opinion -> proveEncryption elecPubKey zkp $+		if opinion+		then ([booleanDisjunctions List.!!0],[])+		else ([],[booleanDisjunctions List.!!1]))+	 opinionsBools encryptions+	sumProof <- proveEncryption elecPubKey zkp+	 ((List.tail <$>) $ List.genericSplitAt (nat (opinionsSum - question_mini)) $+		intervalDisjunctions question_mini question_maxi)+	 ( sum (fst <$> encryptions) -- NOTE: sum the 'encNonce's+	 , sum (snd <$> encryptions) -- NOTE: sum the 'Encryption's+	 )+	return $ Answer+	 { answer_opinions = List.zip+		 (snd <$> encryptions) -- NOTE: drop encNonce+		 individualProofs+	 , answer_sumProof = sumProof+	 }  where 	opinionsSum = sum opinions 	opinions = (\o -> if o then one else zero) <$> opinionsBools@@ -380,18 +379,29 @@  SubGroup q =>  PublicKey q -> ZKP ->  Question q -> Answer q -> Bool-verifyAnswer pubKey zkp Question{..} Answer{..}+verifyAnswer elecPubKey zkp Question{..} Answer{..}  | List.length question_choices /= List.length answer_opinions = False  | otherwise = either (const False) id $ Exn.runExcept $ do 	validOpinions <--		verifyEncryption pubKey zkp booleanDisjunctions+		verifyEncryption elecPubKey zkp booleanDisjunctions 		 `traverse` answer_opinions-	validSum <- verifyEncryption pubKey zkp+	validSum <- verifyEncryption elecPubKey zkp 	 (intervalDisjunctions question_mini question_maxi) 	 ( sum (fst <$> answer_opinions) 	 , answer_sumProof ) 	return (and validOpinions && validSum) +-- ** Type 'ErrorAnswer'+-- | Error raised by 'encryptAnswer'.+data ErrorAnswer+ =   ErrorAnswer_WrongNumberOfOpinions Natural Natural+     -- ^ When the number of opinions is different than+     -- the number of choices ('question_choices').+ |   ErrorAnswer_WrongSumOfOpinions Natural Natural Natural+     -- ^ When the sum of opinions is not within the bounds+     -- of 'question_mini' and 'question_maxi'.+ deriving (Eq,Show)+ -- * Type 'Election' data Election q = Election  { election_name        :: Text@@ -429,25 +439,28 @@ 		 (fromIntegral $ List.length opinionsByQuest) 		 (fromIntegral $ List.length election_questions)  | otherwise = do-	let (keysMay, zkp) =+	let (voterKeys, voterZKP) = 		case secKeyMay of 		 Nothing -> (Nothing, ZKP "") 		 Just secKey -> 			( Just (secKey, pubKey)-			, ZKP (fromString (show (natG pubKey))) )-			where pubKey = groupGen ^ secKey+			, ZKP (bytesNat pubKey) )+			where pubKey = publicKey secKey 	ballot_answers <- 		hoist (Exn.withExceptT ErrorBallot_Answer) $-			zipWithM (encryptAnswer election_publicKey zkp)+			zipWithM (encryptAnswer election_publicKey voterZKP) 			 election_questions opinionsByQuest-	ballot_signature <- case keysMay of+	ballot_signature <- case voterKeys of 	 Nothing -> return Nothing 	 Just (secKey, signature_publicKey) -> do 		signature_proof <- 			prove secKey (Identity groupGen) $ 			 \(Identity commitment) -> 				hash-				 (signatureCommitments zkp commitment)+				 -- NOTE: the order is unusual, the commitments are first+				 -- then comes the statement. Best guess is that+				 -- this is easier to code due to their respective types.+				 (signatureCommitments voterZKP commitment) 				 (signatureStatement ballot_answers) 		return $ Just Signature{..} 	return Ballot@@ -466,7 +479,7 @@ 		case ballot_signature of 		 Nothing -> (True, ZKP "") 		 Just Signature{..} ->-			let zkp = ZKP (fromString (show (natG signature_publicKey))) in+			let zkp = ZKP (bytesNat signature_publicKey) in 			(, zkp) $ 				proof_challenge signature_proof == hash 				 (signatureCommitments zkp (commit signature_proof groupGen signature_publicKey))@@ -479,26 +492,30 @@ -- ** Type 'Signature' -- | Schnorr-like signature. ----- Used to avoid 'Ballot' stuffing.+-- Used by each voter to sign his/her encrypted 'Ballot'+-- using his/her 'Credential',+-- in order to avoid ballot stuffing. data Signature q = Signature  { signature_publicKey :: PublicKey q+   -- ^ Verification key.  , signature_proof     :: Proof q  } +-- *** Hashing+ -- | @('signatureStatement' answers)@--- returns all the 'encryption_nonce's and 'encryption_vault's--- of the given @answers@.+-- returns the encrypted material to be signed:+-- all the 'encryption_nonce's and 'encryption_vault's of the given @answers@. signatureStatement :: Foldable f => SubGroup q => f (Answer q) -> [G q] signatureStatement = 	foldMap $ \Answer{..} -> 		(`foldMap` answer_opinions) $ \(Encryption{..}, _proof) -> 			[encryption_nonce, encryption_vault] --- | @('signatureCommitments' zkp commitment)@--- returns the hashable content from the knowledge of the verifier.+-- | @('signatureCommitments' voterZKP commitment)@ signatureCommitments :: SubGroup q => ZKP -> Commitment q -> BS.ByteString-signatureCommitments (ZKP zkp) commitment =-	"sig|"<>zkp<>"|"<>fromString (show (natG commitment))<>"|"+signatureCommitments (ZKP voterZKP) commitment =+	"sig|"<>voterZKP<>"|"<>bytesNat commitment<>"|"  -- ** Type 'ErrorBallot' -- | Error raised by 'encryptBallot'.@@ -509,3 +526,72 @@  |   ErrorBallot_Answer ErrorAnswer      -- ^ When 'encryptAnswer' raised an 'ErrorAnswer'.  deriving (Eq,Show)++-- * Type 'DecryptionShare'+-- | A decryption share. It is computed by a trustee from his/her+-- private key share and the encrypted tally,+-- and contains a cryptographic 'Proof' that he/she didn't cheat.+data DecryptionShare q = DecryptionShare+ { decryptionShare_factors :: [[DecryptionFactor q]]+ , decryptionShare_proofs  :: [[Proof q]]+   -- ^ 'Proof's that 'decryptionShare_factors' were correctly computed.+ } deriving (Eq,Show)++computeDecryptionShare ::+ Monad m => SubGroup q => RandomGen r =>+ SecretKey q -> [[Encryption q]] -> S.StateT r m (DecryptionShare q)+computeDecryptionShare secKey encs = do+	res <- mapM (mapM (decryptionFactor secKey)) encs+	return $ uncurry DecryptionShare $ List.unzip (List.unzip <$> res)++decryptionFactor ::+ Monad m => SubGroup q => RandomGen r =>+ SecretKey q -> Encryption q -> S.StateT r m (DecryptionFactor q, Proof q)+decryptionFactor secKey Encryption{..} = do+	proof <- prove secKey [groupGen, encryption_nonce] (hash zkp)+	return (encryption_nonce^secKey, proof)+	where zkp = decryptionStatement (publicKey secKey)++decryptionStatement :: SubGroup q => PublicKey q -> BS.ByteString+decryptionStatement pubKey =+	"decrypt|"<>bytesNat pubKey<>"|"++-- ** Type 'DecryptionFactor'+type DecryptionFactor = G++-- ** Type 'ErrorDecryptionShare'+data ErrorDecryptionShare+ =   ErrorDecryptionShare_Invalid+ deriving (Eq,Show)++-- | @('checkDecryptionShare' encTally pubKey decShare)@+-- checks that 'decShare'+-- (supposedly submitted by a trustee whose public key is 'pubKey')+-- is valid with respect to the encrypted tally 'encTally'.+checkDecryptionShare ::+ Monad m => SubGroup q => RandomGen r =>+ [[Encryption q]] -> PublicKey q -> DecryptionShare q ->+ Exn.ExceptT ErrorDecryptionShare m Bool+checkDecryptionShare encTally pubKey DecryptionShare{..}+ | len <- List.length encTally+ , len == List.length decryptionShare_factors+ , len == List.length decryptionShare_proofs =+	Exn.throwE ErrorDecryptionShare_Invalid+ | otherwise =+	return $ and $ join $ List.zipWith3 (List.zipWith3+	 (\encFactor proof Encryption{..} ->+		hash zkp+		 [ commit proof groupGen pubKey+		 , commit proof encryption_nonce encFactor+		 ] == proof_challenge proof+	 )) decryptionShare_factors decryptionShare_proofs encTally+	where zkp = decryptionStatement pubKey++{-+computeElectionResult ::+ Natural ->+ [Encryption q] ->+ [DecryptionShare q] ->+ ElectionResult q+computeElectionResult numBallots encTally decShares+-}

@@ -2,7 +2,7 @@ -- PVP:  +-+------- breaking API changes --       | | +----- non-breaking API additions --       | | | +--- code changes with no API change-version: 0.0.0.20190428+version: 0.0.0.20190501 category: Politic synopsis: A cryptographic protocol for the Majority Judgment. description:@@ -20,8 +20,11 @@   (TODO) Actually, this protocol is adapted a little bit here to better support   a better method of voting known as the <http://libgen.io/book/index.php?md5=BF67AA4298C1CE7633187546AA53E01D Majority Judgment>.   .-  A large-public introduction (in french) to Helios-C is available here:-  <https://members.loria.fr/VCortier/files/Papers/Bulletin1024-2016.pdf Bulletin de la société informatique de France – numéro 9, novembre 2016>.+  * A large-public introduction (in french) to Helios-C is available here:+    <https://members.loria.fr/VCortier/files/Papers/Bulletin1024-2016.pdf Bulletin de la société informatique de France – numéro 9, novembre 2016>.+  * A more scientific (yet understandable) introduction (in english) to Belenios+    (an implementation of Helios-C) is available here:+    <https://hal.inria.fr/hal-02066930/document Belenios: a simple private and verifiable electronic voting system>.   .   The main properties of this protocol are:   .

@@ -22,17 +22,19 @@  , testGroup "hash" 	 [ testGroup "WeakParams" 		 [ testCase "[groupGen]" $-			hash "start" [groupGen @WeakParams] @?= inE 80+			hash "start" [groupGen @WeakParams] @?=+				fromNatural 100 		 , testCase "[groupGen, groupGen]" $-			hash "start" [groupGen @WeakParams, groupGen] @?= inE 117+			hash "start" [groupGen @WeakParams, groupGen] @?=+				fromNatural 16 		 ] 	 , testGroup "BeleniosParams" 		 [ testCase "[groupGen]" $ 			hash "start" [groupGen @BeleniosParams] @?=-				inE 1115773133278002110129249165266+				fromNatural 1832875488615060263192702367259 		 , testCase "[groupGen, groupGen]" $ 			hash "start" [groupGen @BeleniosParams, groupGen] @?=-				inE 1237765159213600087872608890753+				fromNatural 2495277906542783643199702546512 		 ] 	 ]  ]

@@ -28,10 +28,10 @@  [ testGroup "groupGenInverses" 	 [ testCase "WeakParams" $ 		List.take 10 (groupGenInverses @WeakParams) @?=-			[groupGen^neg (inE i) | i <- [0..9::Int]]+			[groupGen^neg (fromNatural n) | n <- [0..9]] 	 , testCase "BeleniosParams" $ 		List.take 10 (groupGenInverses @BeleniosParams) @?=-			[groupGen^neg (inE i) | i <- [0..9::Int]]+			[groupGen^neg (fromNatural n) | n <- [0..9]] 	 ]  , testGroup "encryptBallot" $ 	 [ testsEncryptBallot @WeakParams