hjugement-protocol 0.0.7.20190815 → 0.0.8.20191027

raw patch · 20 files changed

+1348/−724 lines, 20 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• benchmarks/Election.hs +83/−41
• hjugement-protocol.cabal +4/−2
• src/Voting/Protocol.hs +12/−1
• src/Voting/Protocol/Arith.hs +335/−0
• src/Voting/Protocol/Credential.hs +31/−31
• src/Voting/Protocol/Election.hs +449/−164
• src/Voting/Protocol/FFC.hs +45/−296
• src/Voting/Protocol/Tally.hs +102/−34
• src/Voting/Protocol/Trustee/Indispensable.hs +55/−16
• src/Voting/Protocol/Utils.hs +10/−1
• tests/HUnit.hs +7/−6
• tests/HUnit/Credential.hs +9/−6
• tests/HUnit/Election.hs +37/−28
• tests/HUnit/FFC.hs +22/−18
• tests/HUnit/Trustee.hs +4/−3
• tests/HUnit/Trustee/Indispensable.hs +50/−31
• tests/Main.hs +8/−6
• tests/QuickCheck.hs +5/−4
• tests/QuickCheck/Election.hs +58/−24
• tests/QuickCheck/Trustee.hs +22/−12

@@ -1,14 +1,23 @@ {-# LANGUAGE OverloadedStrings #-} module Election where +import Control.DeepSeq (NFData) import qualified Data.List as List import qualified Data.Text as Text import qualified Text.Printf as Printf+import qualified Data.Aeson as JSON  import Voting.Protocol import Utils -makeElection :: forall c. Reifies c FFC => Int -> Int -> Election c+makeElection ::+ forall crypto v c.+ Reifies v Version =>+ Reifies c crypto =>+ JSON.ToJSON crypto =>+ JSON.ToJSON (FieldElement crypto c) =>+ Key crypto =>+ Int -> Int -> Election crypto v c makeElection nQuests nChoices = elec 	where 	election_uuid = UUID "xLcs7ev6Jy6FHH"@@ -16,10 +25,12 @@ 	 { election_name = Text.pack $ "elec"<>show nQuests<>show nChoices 	 , election_description = "benchmarkable election" 	 , election_uuid-	 , election_crypto = ElectionCrypto_FFC (reflect (Proxy::Proxy c)) $+	 , election_crypto = reflect (Proxy @c)+	 , election_public_key = 		let secKey = credentialSecretKey election_uuid (Credential "xLcs7ev6Jy6FHHE") in 		publicKey secKey 	 , election_hash = hashElection elec+	 , election_version = Just (reflect (Proxy @v)) 	 , election_questions = 		(<$> [1..nQuests]) $ \quest -> Question 		 { question_text = Text.pack $ "quest"<>show quest@@ -29,13 +40,20 @@ 		 } 	 } -makeVotes :: Election c -> [[Bool]]+makeVotes :: Election crypto v c -> [[Bool]] makeVotes Election{..} = 	[ True : List.tail [ False | _choice <- question_choices quest ] 	| quest <- election_questions 	] -makeBallot :: Reifies c FFC => Election c -> Ballot c+makeBallot ::+ Reifies v Version =>+ Reifies c crypto =>+ Group crypto =>+ Key crypto =>+ Multiplicative (FieldElement crypto c) =>+ ToNatural (FieldElement crypto c) =>+ Election crypto v c -> Ballot crypto v c makeBallot elec = 	case runExcept $ (`evalStateT` mkStdGen seed) $ do 		ballotSecKey <- randomSecretKey@@ -46,7 +64,7 @@ 	where 	seed = 0 -titleElection :: Election c -> String+titleElection :: Election crypto v c -> String titleElection Election{..} = 	Printf.printf "(questions=%i)×(choices=%i)==%i" 	 nQuests nChoices (nQuests * nChoices)@@ -54,26 +72,48 @@ 	nQuests  = List.length election_questions 	nChoices = List.foldr max 0 $ List.length . question_choices <$> election_questions -benchEncryptBallot :: FFC -> Int -> Int -> Benchmark-benchEncryptBallot ffc nQuests nChoices =-	reify ffc $ \(Proxy::Proxy c) ->-		let setupEnv = do-			let elec :: Election c = makeElection nQuests nChoices-			return elec in-		env setupEnv $ \ ~(elec) ->-			bench (titleElection elec) $-				nf makeBallot elec+benchEncryptBallot ::+ forall crypto v c.+ Reifies v Version =>+ Reifies c crypto =>+ JSON.ToJSON crypto =>+ Group crypto =>+ Key crypto =>+ NFData crypto =>+ NFData (FieldElement crypto c) =>+ Multiplicative (FieldElement crypto c) =>+ ToNatural (FieldElement crypto c) =>+ JSON.ToJSON (FieldElement crypto c) =>+ Proxy v -> Proxy c -> Int -> Int -> Benchmark+benchEncryptBallot (_v::Proxy v) (_c::Proxy c) nQuests nChoices =+	let setupEnv = do+		let elec :: Election crypto v c = makeElection nQuests nChoices+		return elec in+	env setupEnv $ \ ~(elec) ->+		bench (titleElection elec) $+			nf makeBallot elec -benchVerifyBallot :: FFC -> Int -> Int -> Benchmark-benchVerifyBallot ffc nQuests nChoices =-	reify ffc $ \(Proxy::Proxy c) ->-		let setupEnv = do-			let elec :: Election c = makeElection nQuests nChoices-			let ballot = makeBallot elec-			return (elec,ballot) in-		env setupEnv $ \ ~(elec, ballot) ->-			bench (titleElection elec) $-				nf (verifyBallot elec) ballot+benchVerifyBallot ::+ forall crypto v c.+ Reifies v Version =>+ Reifies c crypto =>+ JSON.ToJSON crypto =>+ Group crypto =>+ Key crypto =>+ NFData crypto =>+ NFData (FieldElement crypto c) =>+ Multiplicative (FieldElement crypto c) =>+ ToNatural (FieldElement crypto c) =>+ JSON.ToJSON (FieldElement crypto c) =>+ Proxy v -> Proxy c -> Int -> Int -> Benchmark+benchVerifyBallot (_v::Proxy v) (_c::Proxy c) nQuests nChoices =+	let setupEnv = do+		let elec :: Election crypto v c = makeElection nQuests nChoices+		let ballot = makeBallot elec+		return (elec,ballot) in+	env setupEnv $ \ ~(elec, ballot) ->+		bench (titleElection elec) $+			nf (verifyBallot elec) ballot  benchmarks :: [Benchmark] benchmarks =@@ -82,24 +122,26 @@ 	 | nQ <- [1,5,10,15,20,25] 	 , nC <- [5,7] 	 ] in- [ bgroup "weakFFC"-	 [ bgroup "encryptBallot"-		 [ benchEncryptBallot weakFFC nQuests nChoices-		 | (nQuests,nChoices) <- inputs-		 ]-	 , bgroup "verifyBallot"-		 [ benchVerifyBallot weakFFC nQuests nChoices-		 | (nQuests,nChoices) <- inputs-		 ]-	 ]- , bgroup "beleniosFFC"-	 [ bgroup "encryptBallot"-		 [ benchEncryptBallot beleniosFFC nQuests nChoices-		 | (nQuests,nChoices) <- inputs+ [ bgroup "stableVersion" $ reify stableVersion $ \v ->+	 [ bgroup "weakFFC" $ reify weakFFC $ \c ->+		 [ bgroup "encryptBallot"+			 [ benchEncryptBallot v c nQuests nChoices+			 | (nQuests,nChoices) <- inputs+			 ]+		 , bgroup "verifyBallot"+			 [ benchVerifyBallot v c nQuests nChoices+			 | (nQuests,nChoices) <- inputs+			 ] 		 ]-	 , bgroup "verifyBallot"-		 [ benchVerifyBallot beleniosFFC nQuests nChoices-		 | (nQuests,nChoices) <- inputs+	 , bgroup "beleniosFFC" $ reify beleniosFFC $ \c ->+		 [ bgroup "encryptBallot"+			 [ benchEncryptBallot v c nQuests nChoices+			 | (nQuests,nChoices) <- inputs+			 ]+		 , bgroup "verifyBallot"+			 [ benchVerifyBallot v c nQuests nChoices+			 | (nQuests,nChoices) <- inputs+			 ] 		 ] 	 ]  ]

@@ -2,7 +2,7 @@ -- PVP:  +-+------- breaking API changes --       | | +----- non-breaking API additions --       | | | +--- code changes with no API change-version: 0.0.7.20190815+version: 0.0.8.20191027 category: Politic synopsis: A cryptographic protocol for the Majority Judgment. description:@@ -61,9 +61,10 @@   hs-source-dirs: src   exposed-modules:     Voting.Protocol-    Voting.Protocol.FFC+    Voting.Protocol.Arith     Voting.Protocol.Credential     Voting.Protocol.Election+    Voting.Protocol.FFC     Voting.Protocol.Tally     Voting.Protocol.Trustee     Voting.Protocol.Trustee.Indispensable@@ -212,6 +213,7 @@     , hjugement-protocol     , containers >= 0.5     , criterion >= 1.4+    , deepseq >= 1.4     , QuickCheck >= 2.11     , random >= 1.1     , text >= 1.2

@@ -1,13 +1,24 @@ module Voting.Protocol- ( module Voting.Protocol.FFC+ ( module Voting.Protocol.Arith+ , module Voting.Protocol.FFC  , module Voting.Protocol.Credential  , module Voting.Protocol.Election  , module Voting.Protocol.Tally  , module Voting.Protocol.Trustee+ , Natural+ , RandomGen+ , Reifies(..), reify+ , Proxy(..)  ) where +import Voting.Protocol.Arith import Voting.Protocol.FFC import Voting.Protocol.Credential import Voting.Protocol.Election import Voting.Protocol.Tally import Voting.Protocol.Trustee++import Data.Proxy (Proxy(..))+import Data.Reflection (Reifies(..), reify)+import Numeric.Natural (Natural)+import System.Random (RandomGen)

@@ -0,0 +1,335 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Rank2Types #-} -- for ReifyCrypto+{-# LANGUAGE UndecidableInstances #-} -- for Reifies instances+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- | Finite Field Cryptography (FFC)+-- is a method of implementing discrete logarithm cryptography+-- using finite field mathematics.+module Voting.Protocol.Arith where++import Control.Arrow (first)+import Control.DeepSeq (NFData)+import Control.Monad (Monad(..))+import Data.Aeson (ToJSON(..),FromJSON(..))+import Data.Bits+import Data.Bool+import Data.Eq (Eq(..))+import Data.Foldable (Foldable, foldl')+import Data.Function (($), (.), id)+import Data.Functor ((<$>))+import Data.Int (Int)+import Data.Maybe (Maybe(..), fromJust)+import Data.Ord (Ord(..))+import Data.Proxy (Proxy(..))+import Data.Reflection (Reifies(..))+import Data.Semigroup (Semigroup(..))+import Data.String (IsString(..))+import Data.Text (Text)+import GHC.Generics (Generic)+import GHC.Natural (minusNaturalMaybe)+import Numeric.Natural (Natural)+import Prelude (Integer, Integral(..), fromIntegral, Enum(..))+import Text.Read (readMaybe)+import Text.Show (Show(..))+import qualified Control.Monad.Trans.State.Strict as S+import qualified Crypto.Hash 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.ByteString.Base64 as BS64+import qualified Data.Char as Char+import qualified Data.List as List+import qualified Data.Text as Text+import qualified Data.Text.Encoding 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++-- * Class 'Additive'+class Additive a where+	zero :: a+	(+) :: a -> a -> a; infixl 6 ++	sum :: Foldable f => f a -> a+	sum = foldl' (+) zero+instance Additive Natural where+	zero = 0+	(+)  = (Num.+)+instance Additive Integer where+	zero = 0+	(+)  = (Num.+)+instance Additive Int where+	zero = 0+	(+)  = (Num.+)++-- ** Class 'Negable'+class Additive a => Negable a where+	neg :: a -> a+	(-) :: a -> a -> a; infixl 6 -+	x-y = x + neg y+instance Negable Integer where+	neg  = Num.negate+instance Negable Int where+	neg  = Num.negate++-- * Class 'Multiplicative'+class Multiplicative a where+	one :: a+	(*) :: a -> a -> a; infixl 7 *+instance Multiplicative Natural where+	one = 1+	(*) = (Num.*)+instance Multiplicative Integer where+	one = 1+	(*) = (Num.*)+instance Multiplicative Int where+	one = 1+	(*) = (Num.*)++-- ** Class 'Invertible'+class Multiplicative a => Invertible a where+	inv :: a -> a+	(/) :: a -> a -> a; infixl 7 /+	x/y = x * inv y++-- | @(b '^' e)@ returns the modular exponentiation of base 'b' by exponent 'e'.+(^) ::+ Reifies c crypto =>+ Multiplicative (FieldElement crypto c) =>+ G crypto c -> E crypto c -> G crypto c+(^) b (E e)+ | e == 0 = one+ | otherwise = t * (b*b) ^ E (e`shiftR`1)+	where+	t | testBit e 0 = b+		| otherwise   = one+infixr 8 ^++-- | 'groupGenInverses' returns the infinite list+-- of 'inv'erse powers of 'groupGen':+-- @['groupGen' '^' 'neg' i | i <- [0..]]@,+-- but by computing each value from the previous one.+--+-- Used by 'intervalDisjunctions'.+groupGenInverses ::+ forall crypto c.+ Reifies c crypto =>+ Group crypto =>+ Multiplicative (FieldElement crypto c) =>+ [G crypto c]+groupGenInverses = go one+	where+	invGen = inv $ groupGen @crypto @c+	go g = g : go (g * invGen)++groupGenPowers ::+ forall crypto c.+ Reifies c crypto =>+ Group crypto =>+ Multiplicative (FieldElement crypto c) =>+ [G crypto c]+groupGenPowers = go one+	where go g = g : go (g * groupGen @crypto @c)++-- | @('randomR' i)@ returns a random integer in @[0..i-1]@.+randomR ::+ Monad m =>+ Random.RandomGen r =>+ Random.Random i =>+ Negable i =>+ Multiplicative i =>+ i -> S.StateT r m i+randomR i = S.StateT $ return . Random.randomR (zero, i-one)++-- | @('random')@ returns a random integer+-- in the range determined by its type.+random ::+ Monad m =>+ Random.RandomGen r =>+ Random.Random i =>+ Negable i =>+ Multiplicative i =>+ S.StateT r m i+random = S.StateT $ return . Random.random++instance Random.Random Natural where+	randomR (mini,maxi) =+		first (fromIntegral::Integer -> Natural) .+		Random.randomR (fromIntegral mini, fromIntegral maxi)+	random = first (fromIntegral::Integer -> Natural) . Random.random++-- * Type family 'FieldElement'+type family FieldElement crypto :: * -> *++-- * Class 'Group' where+class Group crypto where+	groupGen   :: Reifies c crypto => G crypto c+	groupOrder :: Reifies c crypto => Proxy c -> Natural++-- ** Type 'G'+-- | The type of the elements of a subgroup of a field.+newtype G crypto c = G { unG :: FieldElement crypto c }+deriving newtype instance Eq     (FieldElement crypto c) => Eq     (G crypto c)+deriving newtype instance Ord    (FieldElement crypto c) => Ord    (G crypto c)+deriving newtype instance Show   (FieldElement crypto c) => Show   (G crypto c)+deriving newtype instance NFData (FieldElement crypto c) => NFData (G crypto c)+instance ToJSON (FieldElement crypto c) => ToJSON (G crypto c) where+	toJSON = JSON.toJSON . unG+instance FromNatural (FieldElement crypto c) => FromNatural (G crypto c) where+	fromNatural = G . fromNatural+instance ToNatural (FieldElement crypto c) => ToNatural (G crypto c) where+	nat = nat . unG+instance Multiplicative (FieldElement crypto c) => Multiplicative (G crypto c) where+	one = G one+	G x * G y = G (x * y)+instance+ ( Reifies c crypto+ , Group crypto+ , Multiplicative (FieldElement crypto c)+ ) => Invertible (G crypto c) where+	-- | NOTE: add 'groupOrder' so the exponent given to (^) is positive.+	inv = (^ E (fromJust $ groupOrder @crypto (Proxy @c)`minusNaturalMaybe`1))++-- ** Type 'E'+-- | An exponent of a (cyclic) subgroup of a field.+-- The value is always in @[0..'groupOrder'-1]@.+newtype E crypto c = E { unE :: Natural }+ deriving (Eq,Ord,Show)+ deriving newtype NFData+instance ToJSON (E crypto c) where+	toJSON = JSON.toJSON . show . unE+instance (Reifies c crypto, Group crypto) => FromJSON (E crypto c) where+	parseJSON (JSON.String s)+	 | Just (c0,_) <- Text.uncons s+	 , c0 /= '0'+	 , Text.all Char.isDigit s+	 , Just x <- readMaybe (Text.unpack s)+	 , x < groupOrder @crypto (Proxy @c)+	 = return (E x)+	parseJSON json = JSON.typeMismatch "Exponent" json+instance (Reifies c crypto, Group crypto) => FromNatural (E crypto c) where+	fromNatural i =+		E $ abs $ i `mod` groupOrder @crypto (Proxy @c)+		where+		abs x | x < 0 = x + groupOrder @crypto (Proxy @c)+		      | otherwise = x+instance ToNatural (E crypto c) where+	nat = unE+instance (Reifies c crypto, Group crypto) => Additive (E crypto c) where+	zero = E zero+	E x + E y = E $ (x + y) `mod` groupOrder @crypto (Proxy @c)+instance (Reifies c crypto, Group crypto) => Negable (E crypto c) where+	neg (E x)+	 | x == 0 = zero+	 | otherwise = E $ fromJust $ nat (groupOrder @crypto (Proxy @c))`minusNaturalMaybe`x+instance (Reifies c crypto, Group crypto) => Multiplicative (E crypto c) where+	one = E one+	E x * E y = E $ (x * y) `mod` groupOrder @crypto (Proxy @c)+instance (Reifies c crypto, Group crypto) => Random.Random (E crypto c) where+	randomR (E lo, E hi) =+		first (E . fromIntegral) .+		Random.randomR+		 ( 0`max`toInteger lo+		 , toInteger hi`min`(toInteger (groupOrder @crypto (Proxy @c)) - 1) )+	random =+		first (E . fromIntegral) .+		Random.randomR (0, toInteger (groupOrder @crypto (Proxy @c)) - 1)+instance (Reifies c crypto, Group crypto) => Enum (E crypto c) where+	toEnum = fromNatural . fromIntegral+	fromEnum = fromIntegral . nat+	enumFromTo lo hi = List.unfoldr+	 (\i -> if i<=hi then Just (i, i+one) else Nothing) lo++-- * Class 'FromNatural'+class FromNatural a where+	fromNatural :: Natural -> a++-- * Class 'ToNatural'+class ToNatural a where+	nat :: a -> Natural+instance ToNatural Natural where+	nat = id++-- | @('bytesNat' x)@ returns the serialization of 'x'.+bytesNat :: ToNatural n => n -> BS.ByteString+bytesNat = fromString . show . nat++-- * Type 'Hash'+newtype Hash crypto c = Hash (E crypto c)+ deriving newtype (Eq,Ord,Show,NFData)++-- | @('hash' bs gs)@ returns as a number in 'GroupExponent'+-- 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.+--+-- 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 ::+ Reifies c crypto =>+ Group crypto =>+ ToNatural (FieldElement crypto c) =>+ BS.ByteString ->+ [G crypto c] ->+ E crypto c+hash bs gs = do+	let s = bs <> BS.intercalate (fromString ",") (bytesNat <$> gs)+	let h = Crypto.hashWith Crypto.SHA256 s+	fromNatural $+		decodeBigEndian $ ByteArray.convert h++-- | @('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 'Base64SHA256'+newtype Base64SHA256 = Base64SHA256 Text+ deriving (Eq,Ord,Show,Generic)+ deriving anyclass (ToJSON,FromJSON)+ deriving newtype NFData++-- | @('base64SHA256' bs)@ returns the 'Crypto.SHA256' hash+-- of the given 'BS.ByteString' 'bs',+-- as a 'Text' escaped in @base64@ encoding+-- (<https://tools.ietf.org/html/rfc4648 RFC 4648>).+base64SHA256 :: BS.ByteString -> Base64SHA256+base64SHA256 bs =+	let h = Crypto.hashWith Crypto.SHA256 bs in+	Base64SHA256 $+		Text.takeWhile (/= '=') $ -- NOTE: no padding.+		Text.decodeUtf8 $ BS64.encode $ ByteArray.convert h++-- ** Type 'HexSHA256'+newtype HexSHA256 = HexSHA256 Text+ deriving (Eq,Ord,Show,Generic)+ deriving anyclass (ToJSON,FromJSON)+ deriving newtype NFData+-- | @('hexSHA256' 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.+hexSHA256 :: BS.ByteString -> Text+hexSHA256 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

@@ -14,23 +14,51 @@ import Data.Int (Int) import Data.Maybe (maybe) import Data.Ord (Ord(..))+import Data.Reflection (Reifies(..)) import Data.Semigroup (Semigroup(..)) import Data.Text (Text) import GHC.Generics (Generic) 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.Char as Char import qualified Data.List as List import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text import qualified System.Random as Random -import Voting.Protocol.FFC+import Voting.Protocol.Arith +-- * Class 'Key'+class Key crypto where+	-- | Type of cryptography, eg. "FFC".+	cryptoType :: crypto -> Text+	-- | Name of the cryptographic paramaters, eg. "Belenios".+	cryptoName :: crypto -> Text+	-- | Generate a random 'SecretKey'.+	randomSecretKey ::+	 Reifies c crypto =>+	 Monad m => Random.RandomGen r =>+	 S.StateT r m (SecretKey crypto c)+	-- | @('credentialSecretKey' uuid cred)@ returns the 'SecretKey'+	-- derived from given 'uuid' and 'cred'+	-- using 'Crypto.fastPBKDF2_SHA256'.+	credentialSecretKey ::+	 Reifies c crypto =>+	 UUID -> Credential -> SecretKey crypto c+	-- | @('publicKey' secKey)@ returns the 'PublicKey'+	-- derived from given 'SecretKey' @secKey@.+	publicKey ::+	 Reifies c crypto =>+	 SecretKey crypto c ->+	 PublicKey crypto c++-- ** Type 'PublicKey'+type PublicKey = G+-- ** Type 'SecretKey'+type SecretKey = E+ -- * Type 'Credential' -- | A 'Credential' is a word of @('tokenLength'+1 '==' 15)@-characters -- from a base alphabet of (@'tokenBase' '==' 58)@ characters:@@ -128,31 +156,3 @@ 	digitOfChar c = 		maybe (Left $ ErrorToken_BadChar c) Right $ 		List.elemIndex c credentialAlphabet---- ** Type 'SecretKey'-type SecretKey = E--randomSecretKey :: Reifies c FFC => Monad m => RandomGen r => S.StateT r m (SecretKey c)-randomSecretKey = random---- | @('credentialSecretKey' uuid cred)@ returns the 'SecretKey'--- derived from given 'uuid' and 'cred'--- using 'Crypto.fastPBKDF2_SHA256'.-credentialSecretKey :: Reifies c FFC => UUID -> Credential -> (SecretKey c)-credentialSecretKey (UUID uuid) (Credential cred) =-	fromNatural $ decodeBigEndian $-	Crypto.fastPBKDF2_SHA256-	 Crypto.Parameters-	 { Crypto.iterCounts   = 1000-	 , Crypto.outputLength = 32 -- bytes, ie. 256 bits-	 }-	 (Text.encodeUtf8 cred)-	 (Text.encodeUtf8 uuid)---- ** Type 'PublicKey'-type PublicKey = G---- | @('publicKey' secKey)@ returns the 'PublicKey'--- derived from given 'SecretKey' @secKey@.-publicKey :: Reifies c FFC => SecretKey c -> PublicKey c-publicKey = (groupGen ^)

@@ -2,11 +2,11 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE Rank2Types #-} -- for reifyElection+{-# LANGUAGE Rank2Types #-} -- for readElection {-# LANGUAGE UndecidableInstances #-} -- for Reifies instances module Voting.Protocol.Election where -import Control.Applicative (Applicative(..))+import Control.Applicative (Applicative(..), Alternative(..)) import Control.DeepSeq (NFData) import Control.Monad (Monad(..), join, mapM, replicateM, zipWithM) import Control.Monad.Trans.Class (MonadTrans(..))@@ -17,13 +17,15 @@ import Data.Eq (Eq(..)) import Data.Foldable (Foldable, foldMap, and) import Data.Function (($), (.), id, const)-import Data.Functor (Functor, (<$>))+import Data.Functor (Functor, (<$>), (<$)) import Data.Functor.Identity (Identity(..))-import Data.Maybe (Maybe(..), maybe, fromJust)+import Data.Maybe (Maybe(..), maybe, fromJust, fromMaybe, listToMaybe) import Data.Monoid (Monoid(..)) import Data.Ord (Ord(..))+import Data.Proxy (Proxy(..))+import Data.Reflection (Reifies(..), reify) import Data.Semigroup (Semigroup(..))-import Data.String (String)+import Data.String (String, IsString(..)) import Data.Text (Text) import Data.Traversable (Traversable(..)) import Data.Tuple (fst, snd)@@ -32,16 +34,26 @@ import Numeric.Natural (Natural) import Prelude (fromIntegral) import System.IO (IO, FilePath)-import Text.Show (Show(..))+import System.Random (RandomGen)+import Text.Show (Show(..), showChar, showString) import qualified Control.Monad.Trans.State.Strict as S import qualified Data.Aeson as JSON+import qualified Data.Aeson.Encoding as JSON+import qualified Data.Aeson.Internal as JSON+import qualified Data.Aeson.Parser.Internal as JSON+import qualified Data.Aeson.Types as JSON import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL+import qualified Data.Char as Char import qualified Data.List as List+import qualified Data.Text as Text+import qualified Text.ParserCombinators.ReadP as Read+import qualified Text.Read as Read  import Voting.Protocol.Utils-import Voting.Protocol.FFC+import Voting.Protocol.Arith import Voting.Protocol.Credential+import Voting.Protocol.FFC (FFC)  -- * Type 'Encryption' -- | ElGamal-like encryption.@@ -55,15 +67,22 @@ -- -- NOTE: Since @('encryption_vault' '*' 'encryption_nonce' '==' 'encryption_nonce' '^' (secKey '+' clear))@, -- then: @(logBase 'encryption_nonce' ('encryption_vault' '*' 'encryption_nonce') '==' secKey '+' clear)@.-data Encryption c = Encryption- { encryption_nonce :: !(G c)+data Encryption crypto v c = Encryption+ { encryption_nonce :: !(G crypto c)    -- ^ Public part of the randomness 'encNonce' used to 'encrypt' the 'clear' text,    -- equal to @('groupGen' '^'encNonce)@- , encryption_vault :: !(G c)+ , encryption_vault :: !(G crypto c)    -- ^ Encrypted 'clear' text,    -- equal to @('pubKey' '^'encNone '*' 'groupGen' '^'clear)@- } deriving (Eq,Show,Generic,NFData)-instance Reifies c FFC => ToJSON (Encryption c) where+ } deriving (Generic)+deriving instance Eq (FieldElement crypto c) => Eq (Encryption crypto v c)+deriving instance (Show (FieldElement crypto c), Show (G crypto c)) => Show (Encryption crypto v c)+deriving instance NFData (FieldElement crypto c) => NFData (Encryption crypto v c)+instance+ ( Reifies v Version+ , Reifies c crypto+ , ToJSON (FieldElement crypto c)+ ) => ToJSON (Encryption crypto v c) where 	toJSON Encryption{..} = 		JSON.object 		 [ "alpha" .= encryption_nonce@@ -74,7 +93,11 @@ 		 (  "alpha" .= encryption_nonce 		 <> "beta"  .= encryption_vault 		 )-instance Reifies c FFC => FromJSON (Encryption c) where+instance+ ( Reifies v Version+ , Reifies c crypto+ , FromJSON (G crypto c)+ ) => FromJSON (Encryption crypto v c) where 	parseJSON = JSON.withObject "Encryption" $ \o -> do 		encryption_nonce <- o .: "alpha" 		encryption_vault <- o .: "beta"@@ -82,7 +105,10 @@  -- | Additive homomorphism. -- Using the fact that: @'groupGen' '^'x '*' 'groupGen' '^'y '==' 'groupGen' '^'(x'+'y)@.-instance Reifies c FFC => Additive (Encryption c) where+instance+ ( Reifies c crypto+ , Multiplicative (FieldElement crypto c)+ ) => Additive (Encryption crypto v c) where 	zero = Encryption one one 	x+y = Encryption 	 (encryption_nonce x * encryption_nonce y)@@ -100,10 +126,13 @@ -- as it may be used to decipher the 'Encryption' -- without the 'SecretKey' associated with 'pubKey'. encrypt ::- Reifies c FFC =>+ Reifies v Version =>+ Reifies c crypto =>+ Group crypto =>+ Multiplicative (FieldElement crypto c) =>  Monad m => RandomGen r =>- PublicKey c -> E c ->- S.StateT r m (EncryptionNonce c, Encryption c)+ PublicKey crypto c -> E crypto c ->+ S.StateT r m (EncryptionNonce crypto c, Encryption crypto v c) encrypt pubKey clear = do 	encNonce <- random 	-- NOTE: preserve the 'encNonce' for 'prove' in 'proveEncryption'.@@ -117,8 +146,8 @@ -- | Non-Interactive Zero-Knowledge 'Proof' -- of knowledge of a discrete logarithm: -- @(secret == logBase base (base^secret))@.-data Proof c = Proof- { proof_challenge :: Challenge c+data Proof crypto v c = Proof+ { proof_challenge :: !(Challenge crypto c)    -- ^ 'Challenge' sent by the verifier to the prover    -- to ensure that the prover really has knowledge    -- of the secret and is not replaying.@@ -126,7 +155,7 @@    -- but derived from the prover's 'Commitment's and statements    -- with a collision resistant 'hash'.    -- Hence the prover cannot chose the 'proof_challenge' to his/her liking.- , proof_response :: E c+ , proof_response :: !(E crypto c)    -- ^ A discrete logarithm sent by the prover to the verifier,    -- as a response to 'proof_challenge'.    --@@ -147,8 +176,8 @@    -- The prover choses 'commitment' to be a random power of @base@,    -- to ensure that each 'prove' does not reveal any information    -- about its secret.- } deriving (Eq,Show,Generic,NFData)-instance ToJSON (Proof c) where+ } deriving (Eq,Show,NFData,Generic)+instance Group crypto => ToJSON (Proof crypto v c) where 	toJSON Proof{..} = 		JSON.object 		 [ "challenge" .= proof_challenge@@ -159,7 +188,7 @@ 		 (  "challenge" .= proof_challenge 		 <> "response"  .= proof_response 		 )-instance Reifies c FFC => FromJSON (Proof c) where+instance (Reifies c crypto, Group crypto) => FromJSON (Proof crypto v c) where 	parseJSON = JSON.withObject "TrusteePublicKey" $ \o -> do 		proof_challenge <- o .: "challenge" 		proof_response  <- o .: "response"@@ -191,7 +220,7 @@ -- Indeed, the prover now handles the 'Challenge' -- which becomes a (collision resistant) 'hash' -- of the prover's commitments (and statements to be a stronger proof).-type Oracle list c = list (Commitment c) -> Challenge c+type Oracle list crypto c = list (Commitment crypto c) -> Challenge crypto c  -- | @('prove' sec commitmentBases oracle)@ -- returns a 'Proof' that @sec@ is known@@ -211,25 +240,43 @@ -- because two 'Proof's using the same 'Commitment' -- can be used to deduce @sec@ (using the special-soundness). prove ::- Reifies c FFC =>+ forall crypto v c list m r.+ Reifies c crypto =>+ Reifies v Version =>+ Group crypto =>+ Multiplicative (FieldElement crypto c) =>  Monad m => RandomGen r => Functor list =>- E c -> list (G c) -> Oracle list c -> S.StateT r m (Proof c)+ E crypto c ->+ list (G crypto c) ->+ Oracle list crypto c ->+ S.StateT r m (Proof crypto v c) prove sec commitmentBases oracle = do 	nonce <- random 	let commitments = (^ nonce) <$> commitmentBases 	let proof_challenge = oracle commitments 	return Proof 	 { proof_challenge-	 , proof_response = nonce + sec*proof_challenge-	   -- TODO: switch (+) to (-) when 'commit' will switch (/) to (*).+	 , proof_response = nonce `op` (sec*proof_challenge) 	 }+	where+	-- | See comments in 'commit'.+	op =+		if reflect (Proxy @v) `hasVersionTag` versionTagQuicker+		then (-)+		else (+)  -- | Like 'prove' but quicker. It chould replace 'prove' entirely -- when Helios-C specifications will be fixed. proveQuicker ::- Reifies c FFC =>+ Reifies c crypto =>+ Reifies v Version =>+ Group crypto =>+ Multiplicative (FieldElement crypto c) =>  Monad m => RandomGen r => Functor list =>- E c -> list (G c) -> Oracle list c -> S.StateT r m (Proof c)+ E crypto c ->+ list (G crypto c) ->+ Oracle list crypto c ->+ S.StateT r m (Proof crypto v c) proveQuicker sec commitmentBases oracle = do 	nonce <- random 	let commitments = (^ nonce) <$> commitmentBases@@ -248,9 +295,10 @@ -- Used in 'proveEncryption' to fill the returned 'DisjProof' -- with fake 'Proof's for all 'Disjunction's but the encrypted one. fakeProof ::- Reifies c FFC =>- Monad m =>- RandomGen r => S.StateT r m (Proof c)+ Reifies c crypto =>+ Group crypto =>+ Monad m => RandomGen r =>+ S.StateT r m (Proof crypto v c) fakeProof = do 	proof_challenge <- random 	proof_response  <- random@@ -264,19 +312,39 @@  -- | @('commit' proof base basePowSec)@ returns a 'Commitment' -- from the given 'Proof' with the knowledge of the verifier.-commit :: Reifies c FFC => Proof c -> G c -> G c -> Commitment c+commit ::+ forall crypto v c.+ Reifies v Version =>+ Reifies c crypto =>+ Group crypto =>+ Multiplicative (FieldElement crypto c) =>+ Proof crypto v c ->+ G crypto c ->+ G crypto c ->+ Commitment crypto c commit Proof{..} base basePowSec =-	base^proof_response /-	basePowSec^proof_challenge+	(base^proof_response) `op`+	(basePowSec^proof_challenge)+	where+	op =+		if reflect (Proxy @v) `hasVersionTag` versionTagQuicker+		then (*)+		else (/)   -- TODO: contrary to some textbook presentations,   -- @('*')@ should be used instead of @('/')@ to avoid the performance cost   -- of a modular exponentiation @('^' ('groupOrder' '-' 'one'))@,-  -- this would be compensated by using @('-')@ instead of @('+')@ in 'prove'.+  -- this is compensated by using @('-')@ instead of @('+')@ in 'prove'. {-# INLINE commit #-}  -- | Like 'commit' but quicker. It chould replace 'commit' entirely -- when Helios-C specifications will be fixed.-commitQuicker :: Reifies c FFC => Proof c -> G c -> G c -> Commitment c+commitQuicker ::+ Reifies c crypto =>+ Multiplicative (FieldElement crypto c) =>+ Proof crypto v c ->+ G crypto c ->+ G crypto c ->+ Commitment crypto c commitQuicker Proof{..} base basePowSec = 	base^proof_response * 	basePowSec^proof_challenge@@ -287,29 +355,50 @@ -- that an 'encryption_vault' contains a given @('groupGen' '^'opinion)@, type Disjunction = G -booleanDisjunctions :: Reifies c FFC => [Disjunction c]-booleanDisjunctions = List.take 2 groupGenInverses+booleanDisjunctions ::+ forall crypto c.+ Reifies c crypto =>+ Group crypto =>+ Multiplicative (FieldElement crypto c) =>+ [Disjunction crypto c]+booleanDisjunctions = List.take 2 $ groupGenInverses @crypto -intervalDisjunctions :: Reifies c FFC => Natural -> Natural -> [Disjunction c]+intervalDisjunctions ::+ forall crypto c.+ Reifies c crypto =>+ Group crypto =>+ Multiplicative (FieldElement crypto c) =>+ Natural -> Natural -> [Disjunction crypto c] intervalDisjunctions mini maxi = 	List.genericTake (fromJust $ (nat maxi + 1)`minusNaturalMaybe`nat mini) $ 	List.genericDrop (nat mini) $-	groupGenInverses+	groupGenInverses @crypto  -- ** Type 'Opinion' -- | Index of a 'Disjunction' within a list of them.--- It is encrypted as an 'E'xponent by 'encrypt'.+-- It is encrypted as a 'GroupExponent' 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 revealing which 'Opinion' it is.-newtype DisjProof c = DisjProof [Proof c]+newtype DisjProof crypto v c = DisjProof [Proof crypto v c]  deriving (Eq,Show,Generic)- deriving newtype NFData-deriving newtype instance Reifies c FFC => ToJSON (DisjProof c)-deriving newtype instance Reifies c FFC => FromJSON (DisjProof c)+ deriving newtype (NFData,ToJSON,FromJSON)+{-+deriving instance Eq (GroupExponent crypto c) => Eq (DisjProof crypto v c)+deriving instance Show (GroupExponent crypto c) => Show (DisjProof crypto v c)+deriving newtype instance NFData (GroupExponent crypto c) => NFData (DisjProof crypto v c)+deriving newtype instance+ ( Reifies c crypto+ , ToJSON (GroupExponent crypto c)+ ) => ToJSON (DisjProof crypto v c)+deriving newtype instance+ ( Reifies c crypto+ , FromJSON (GroupExponent crypto c)+ ) => FromJSON (DisjProof crypto v c)+-}  -- | @('proveEncryption' elecPubKey voterZKP (prevDisjs,nextDisjs) (encNonce,enc))@ -- returns a 'DisjProof' that 'enc' 'encrypt's@@ -322,12 +411,16 @@ -- -- DOC: Pierrick Gaudry. <https://hal.inria.fr/hal-01576379 Some ZK security proofs for Belenios>, 2017. proveEncryption ::- Reifies c FFC =>+ Reifies v Version =>+ Reifies c crypto =>+ Group crypto =>+ ToNatural (FieldElement crypto c) =>+ Multiplicative (FieldElement crypto c) =>  Monad m => RandomGen r =>- PublicKey c -> ZKP ->- ([Disjunction c],[Disjunction c]) ->- (EncryptionNonce c, Encryption c) ->- S.StateT r m (DisjProof c)+ PublicKey crypto c -> ZKP ->+ ([Disjunction crypto c],[Disjunction crypto c]) ->+ (EncryptionNonce crypto c, Encryption crypto v c) ->+ S.StateT r m (DisjProof crypto v c) proveEncryption elecPubKey voterZKP (prevDisjs,nextDisjs) (encNonce,enc) = do 	-- Fake proofs for all 'Disjunction's except the genuine one. 	prevFakeProofs <- replicateM (List.length prevDisjs) fakeProof@@ -351,9 +444,14 @@ 	return (DisjProof proofs)  verifyEncryption ::- Reifies c FFC => Monad m =>- PublicKey c -> ZKP ->- [Disjunction c] -> (Encryption c, DisjProof c) ->+ Reifies v Version =>+ Reifies c crypto =>+ Group crypto =>+ ToNatural (FieldElement crypto c) =>+ Multiplicative (FieldElement crypto c) =>+ Monad m =>+ PublicKey crypto c -> ZKP ->+ [Disjunction crypto c] -> (Encryption crypto v c, DisjProof crypto v c) ->  ExceptT ErrorVerifyEncryption m Bool verifyEncryption elecPubKey voterZKP disjs (enc, DisjProof proofs) = 	case isoZipWith (encryptionCommitments elecPubKey enc) disjs proofs of@@ -368,7 +466,10 @@ 	challengeSum = sum (proof_challenge <$> proofs)  -- ** Hashing-encryptionStatement :: Reifies c FFC => ZKP -> Encryption c -> BS.ByteString+encryptionStatement ::+ Reifies c crypto =>+ ToNatural (FieldElement crypto c) =>+ ZKP -> Encryption crypto v c -> BS.ByteString encryptionStatement (ZKP voterZKP) Encryption{..} = 	"prove|"<>voterZKP<>"|" 	 <> bytesNat encryption_nonce<>","@@ -380,9 +481,12 @@ -- For the prover the 'Proof' comes from @fakeProof@, -- and for the verifier the 'Proof' comes from the prover. encryptionCommitments ::- Reifies c FFC =>- PublicKey c -> Encryption c ->- Disjunction c -> Proof c -> [G c]+ Reifies v Version =>+ Reifies c crypto =>+ Group crypto =>+ Multiplicative (FieldElement crypto c) =>+ PublicKey crypto c -> Encryption crypto v c ->+ Disjunction crypto c -> Proof crypto v c -> [G crypto c] encryptionCommitments elecPubKey Encryption{..} disj proof = 	[ commit proof groupGen encryption_nonce 	  -- == groupGen ^ nonce if 'Proof' comes from 'prove'.@@ -402,14 +506,14 @@  deriving (Eq,Show)  -- * Type 'Question'-data Question = Question+data Question v = Question  { question_text    :: !Text  , question_choices :: ![Text]  , question_mini    :: !Natural  , question_maxi    :: !Natural  -- , question_blank :: Maybe Bool  } deriving (Eq,Show,Generic,NFData)-instance ToJSON Question where+instance Reifies v Version => ToJSON (Question v) where 	toJSON Question{..} = 		JSON.object 		 [ "question" .= question_text@@ -424,7 +528,7 @@ 		 <> "min"      .= question_mini 		 <> "max"      .= question_maxi 		 )-instance FromJSON Question where+instance Reifies v Version => FromJSON (Question v) where 	parseJSON = JSON.withObject "Question" $ \o -> do 		question_text    <- o .: "question" 		question_choices <- o .: "answers"@@ -433,16 +537,24 @@ 		return Question{..}  -- * Type 'Answer'-data Answer c = Answer- { answer_opinions :: ![(Encryption c, DisjProof c)]+data Answer crypto v c = Answer+ { answer_opinions :: ![(Encryption crypto v c, DisjProof crypto v c)]    -- ^ Encrypted 'Opinion' for each 'question_choices'    -- with a 'DisjProof' that they belong to [0,1].- , answer_sumProof :: !(DisjProof c)+ , answer_sumProof :: !(DisjProof crypto v c)    -- ^ Proofs that the sum of the 'Opinon's encrypted in 'answer_opinions'    -- is an element of @[mini..maxi]@.  -- , answer_blankProof ::- } deriving (Eq,Show,Generic,NFData)-instance Reifies c FFC => ToJSON (Answer c) where+ } deriving (Generic)+deriving instance Eq (FieldElement crypto c) => Eq (Answer crypto v c)+deriving instance (Show (FieldElement crypto c), Show (G crypto c)) => Show (Answer crypto v c)+deriving instance NFData (FieldElement crypto c) => NFData (Answer crypto v c)+instance+ ( Reifies v Version+ , Reifies c crypto+ , ToJSON (FieldElement crypto c)+ , Group crypto+ ) => ToJSON (Answer crypto v c) where 	toJSON Answer{..} = 		let (answer_choices, answer_individual_proofs) = 			List.unzip answer_opinions in@@ -459,7 +571,12 @@ 		 <> "individual_proofs" .= answer_individual_proofs 		 <> "overall_proof"     .= answer_sumProof 		 )-instance Reifies c FFC => FromJSON (Answer c) where+instance+ ( Reifies v Version+ , Reifies c crypto+ , FromJSON (G crypto c)+ , Group crypto+ ) => FromJSON (Answer crypto v c) where 	parseJSON = JSON.withObject "Answer" $ \o -> do 		answer_choices <- o .: "choices" 		answer_individual_proofs <- o .: "individual_proofs"@@ -471,11 +588,15 @@ -- returns an 'Answer' validable by 'verifyAnswer', -- unless an 'ErrorAnswer' is returned. encryptAnswer ::- Reifies c FFC =>+ Reifies v Version =>+ Reifies c crypto =>+ Group crypto =>+ Multiplicative (FieldElement crypto c) =>+ ToNatural (FieldElement crypto c) =>  Monad m => RandomGen r =>- PublicKey c -> ZKP ->- Question -> [Bool] ->- S.StateT r (ExceptT ErrorAnswer m) (Answer c)+ PublicKey crypto c -> ZKP ->+ Question v -> [Bool] ->+ S.StateT r (ExceptT ErrorAnswer m) (Answer crypto v c) encryptAnswer elecPubKey zkp Question{..} opinionByChoice  | not (question_mini <= opinionsSum && opinionsSum <= question_maxi) = 	lift $ throwE $@@ -511,9 +632,13 @@ 	opinions = (\o -> if o then one else zero) <$> opinionByChoice  verifyAnswer ::- Reifies c FFC =>- PublicKey c -> ZKP ->- Question -> Answer c -> Bool+ Reifies v Version =>+ Reifies c crypto =>+ Group crypto =>+ Multiplicative (FieldElement crypto c) =>+ ToNatural (FieldElement crypto c) =>+ PublicKey crypto c -> ZKP ->+ Question v -> Answer crypto v c -> Bool verifyAnswer elecPubKey zkp Question{..} Answer{..}  | List.length question_choices /= List.length answer_opinions = False  | otherwise = either (const False) id $ runExcept $ do@@ -538,91 +663,160 @@  deriving (Eq,Show,Generic,NFData)  -- * Type 'Election'-data Election c = Election+data Election crypto v c = Election  { election_name        :: !Text  , election_description :: !Text- , election_crypto      :: !(ElectionCrypto c)- , election_questions   :: ![Question]+ , election_questions   :: ![Question v]  , election_uuid        :: !UUID  , election_hash        :: Base64SHA256- } deriving (Eq,Show,Generic,NFData)--instance ToJSON (Election c) where+ , election_crypto      :: !crypto+ , election_version     :: !(Maybe Version)+ , election_public_key  :: !(PublicKey crypto c)+ } deriving (Generic)+deriving instance (Eq crypto, Eq (FieldElement crypto c)) => Eq (Election crypto v c)+deriving instance (Show crypto, Show (FieldElement crypto c)) => Show (Election crypto v c)+deriving instance (NFData crypto, NFData (FieldElement crypto c)) => NFData (Election crypto v c)+instance+ ( ToJSON crypto+ , ToJSON (FieldElement crypto c)+ , Reifies v Version+ , Reifies c crypto+ ) => ToJSON (Election crypto v c) where 	toJSON Election{..} =-		JSON.object-		 [ "name"        .= election_name+		JSON.object $+		 [ "name" .= election_name 		 , "description" .= election_description-		 , "public_key"  .= election_crypto-		 , "questions"   .= election_questions-		 , "uuid"        .= election_uuid-		 ]+		 , ("public_key", JSON.object+			 [ "group" .= election_crypto+			 , "y" .= election_public_key+			 ])+		 , "questions" .= election_questions+		 , "uuid" .= election_uuid+		 ] <>+		 maybe [] (\version -> [ "version" .= version ]) election_version 	toEncoding Election{..} =-		JSON.pairs-		 (  "name"        .= election_name+		JSON.pairs $+		 (  "name" .= election_name 		 <> "description" .= election_description-		 <> "public_key"  .= election_crypto-		 <> "questions"   .= election_questions-		 <> "uuid"        .= election_uuid+		 <> JSON.pair "public_key" (JSON.pairs $+			"group" .= election_crypto+			<> "y" .= election_public_key 		 )-instance FromJSON (Election ()) where-	parseJSON = JSON.withObject "Election" $ \o -> Election-	 <$> o .: "name"-	 <*> o .: "description"-	 <*> o .: "public_key"-	 <*> o .: "questions"-	 <*> o .: "uuid"-	 <*> pure (Base64SHA256 "")-	     -- NOTE: set in 'readElection'.+		 <> "questions" .= election_questions+		 <> "uuid" .= election_uuid+		 ) <>+		 maybe mempty ("version" .=) election_version -readElection :: FilePath -> ExceptT String IO (Election ())-readElection filePath = do+readElection ::+ ReifyCrypto crypto =>+ FromJSON crypto =>+ FilePath ->+ (forall v c.+  Reifies v Version =>+  Reifies c crypto =>+  FieldElementConstraints crypto c =>+  Election crypto v c -> r) ->+ ExceptT String IO r+readElection filePath k = do 	fileData <- lift $ BS.readFile filePath 	ExceptT $ return $-		(\e -> e{election_hash=base64SHA256 fileData})-		 <$> JSON.eitherDecodeStrict' fileData+		jsonEitherFormatError $+			JSON.eitherDecodeStrictWith JSON.jsonEOF+			 (JSON.iparse (parseElection fileData))+			 fileData+	where+	parseElection fileData = JSON.withObject "Election" $ \o -> do+		election_version <- o .:? "version"+		reify (fromMaybe stableVersion election_version) $ \(_v::Proxy v) -> do+			(election_crypto, elecPubKey) <-+				JSON.explicitParseField+				 (JSON.withObject "public_key" $ \obj -> do+						crypto <- obj .: "group"+						pubKey :: JSON.Value <- obj .: "y"+						return (crypto, pubKey)+				 ) o "public_key"+			reifyCrypto election_crypto $ \(_c::Proxy c) -> do+				election_name <- o .: "name"+				election_description <- o .: "description"+				election_questions <- o .: "questions" :: JSON.Parser [Question v]+				election_uuid <- o .: "uuid"+				election_public_key :: PublicKey crypto c <- parseJSON elecPubKey+				return $ k $ Election+				 { election_questions  = election_questions+				 , election_public_key = election_public_key+				 , election_hash       = base64SHA256 fileData+				 , ..+				 } -hashElection :: Election c -> Base64SHA256+hashElection ::+ ToJSON crypto =>+ Reifies c crypto =>+ Reifies v Version =>+ ToJSON (FieldElement crypto c) =>+ Election crypto v c -> Base64SHA256 hashElection = base64SHA256 . BSL.toStrict . JSON.encode --- ** Type 'ElectionCrypto'-data ElectionCrypto c =- ElectionCrypto_FFC- { electionCrypto_FFC_params    :: !FFC- , electionCrypto_FFC_PublicKey :: !(PublicKey c)- } deriving (Eq,Show,Generic,NFData)--reifyElection :: Election () -> (forall c. Reifies c FFC => Election c -> k) -> k-reifyElection Election{..} k =-	case election_crypto of-	 ElectionCrypto_FFC ffc (G (F pubKey)) ->-		reify ffc $ \(_::Proxy c) -> k @c-		 Election{election_crypto = ElectionCrypto_FFC ffc (G (F pubKey)), ..}+-- ** Class 'ReifyCrypto'+-- | @('reifyCrypto' crypto k)@ is like @('reify' crypto k)@+-- but gives to @(k)@ more constraints than just @('Reifies' c crypto)@,+-- which is used when defining classes on @(crypto)@+-- where @(c)@ (the type variable guarantying the same+-- @crypto@graphic parameters are used throughout)+-- is not yet in scope and thus where one cannot+-- add those constraints requiring to have @(c)@ in scope.+-- See for instance the 'QuickcheckElection' class, in the tests.+--+-- For convenience, the 'ReifyCrypto' class also implies the pervasive+-- constraint 'Group'.+class+ ( Group crypto+ , Key crypto+ , Show crypto+ , NFData crypto+ , JSON.ToJSON crypto+ , JSON.FromJSON crypto+ ) => ReifyCrypto crypto where+	reifyCrypto ::+	 crypto -> (forall c.+	  Reifies c crypto =>+	  FieldElementConstraints crypto c =>+	  Proxy c -> r) -> r+instance ReifyCrypto FFC where+	reifyCrypto = reify -instance ToJSON (ElectionCrypto c) where-	toJSON (ElectionCrypto_FFC ffc pubKey) =-		JSON.object-		 [ "group" .= ffc-		 , "y"     .= pubKey-		 ]-	toEncoding (ElectionCrypto_FFC ffc pubKey) =-		JSON.pairs-		 (  "group" .= ffc-		 <> "y"     .= pubKey-		 )-instance FromJSON (ElectionCrypto ()) where-	parseJSON = JSON.withObject "ElectionCrypto" $ \o -> do-		ffc <- o .: "group"-		pubKey <- reify ffc $ \(_::Proxy s) -> nat <$> ((.:) @(PublicKey s) o "y")-		return $ ElectionCrypto_FFC ffc (G (F pubKey))+-- ** Class 'FieldElementConstraints'+-- | List the 'Constraint's on the element of the field+-- when the @(crypto)@ has not been instantiated to a specific type yet.+-- It concerns only 'Constraint's whose method act on @(a)@,+-- not @(x c)@ (eg. 'Group').+type FieldElementConstraints crypto c =+ ( Multiplicative (FieldElement crypto c)+ , FromNatural    (FieldElement crypto c)+ , ToNatural      (FieldElement crypto c)+ , Eq             (FieldElement crypto c)+ , Ord            (FieldElement crypto c)+ , Show           (FieldElement crypto c)+ , NFData         (FieldElement crypto c)+ , FromJSON       (FieldElement crypto c)+ , ToJSON         (FieldElement crypto c)+ , FromJSON       (G crypto c)+ , ToJSON         (G crypto c)+ )  -- * Type 'Ballot'-data Ballot c = Ballot- { ballot_answers       :: ![Answer c]- , ballot_signature     :: !(Maybe (Signature c))+data Ballot crypto v c = Ballot+ { ballot_answers       :: ![Answer crypto v c]+ , ballot_signature     :: !(Maybe (Signature crypto v c))  , ballot_election_uuid :: !UUID  , ballot_election_hash :: !Base64SHA256- } deriving (Generic,NFData)-instance Reifies c FFC => ToJSON (Ballot c) where+ } deriving (Generic)+deriving instance (NFData (FieldElement crypto c), NFData crypto) => NFData (Ballot crypto v c)+instance+ ( Reifies v Version+ , Reifies c crypto+ , Group crypto+ , ToJSON (FieldElement crypto c)+ ) => ToJSON (Ballot crypto v c) where 	toJSON Ballot{..} = 		JSON.object $ 		 [ "answers"       .= ballot_answers@@ -636,8 +830,13 @@ 		 <> "election_uuid" .= ballot_election_uuid 		 <> "election_hash" .= ballot_election_hash 		 ) <>-		 maybe mempty (\sig -> "signature" .= sig) ballot_signature-instance Reifies c FFC => FromJSON (Ballot c) where+		 maybe mempty ("signature" .=) ballot_signature+instance+ ( Reifies v Version+ , Reifies c crypto+ , Group crypto+ , FromJSON (G crypto c)+ ) => FromJSON (Ballot crypto v c) where 	parseJSON = JSON.withObject "Ballot" $ \o -> do 		ballot_answers       <- o .: "answers" 		ballot_signature     <- o .:? "signature"@@ -645,16 +844,22 @@ 		ballot_election_hash <- o .: "election_hash" 		return Ballot{..} --- | @('encryptBallot' elec ('Just' ballotSecKey) opinionsByQuest)@+-- | @('encryptBallot' c ('Just' ballotSecKey) opinionsByQuest)@ -- returns a 'Ballot' signed by 'secKey' (the voter's secret key) -- where 'opinionsByQuest' is a list of 'Opinion's -- on each 'question_choices' of each 'election_questions'. encryptBallot ::- Reifies c FFC =>+ forall crypto m v c r.+ Reifies c crypto =>+ Reifies v Version =>+ Group crypto =>+ Key crypto =>+ Multiplicative (FieldElement crypto c) =>+ ToNatural (FieldElement crypto c) =>  Monad m => RandomGen r =>- Election c ->- Maybe (SecretKey c) -> [[Bool]] ->- S.StateT r (ExceptT ErrorBallot m) (Ballot c)+ Election crypto v c ->+ Maybe (SecretKey crypto c) -> [[Bool]] ->+ S.StateT r (ExceptT ErrorBallot m) (Ballot crypto v c) encryptBallot Election{..} ballotSecKeyMay opinionsByQuest  | List.length election_questions /= List.length opinionsByQuest = 	lift $ throwE $@@ -671,7 +876,7 @@ 			where ballotPubKey = publicKey ballotSecKey 	ballot_answers <- 		S.mapStateT (withExceptT ErrorBallot_Answer) $-			zipWithM (encryptAnswer (electionCrypto_FFC_PublicKey election_crypto) voterZKP)+			zipWithM (encryptAnswer election_public_key voterZKP) 			 election_questions opinionsByQuest 	ballot_signature <- case voterKeys of 	 Nothing -> return Nothing@@ -679,12 +884,12 @@ 		signature_proof <- 			proveQuicker ballotSecKey (Identity groupGen) $ 			 \(Identity commitment) ->-				hash+				hash @_ @crypto 				 -- 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)+				 (signatureCommitments @_ @crypto voterZKP commitment)+				 (signatureStatement @_ @crypto ballot_answers) 		return $ Just Signature{..} 	return Ballot 	 { ballot_answers@@ -693,9 +898,17 @@ 	 , ballot_signature 	 } -verifyBallot :: Reifies c FFC => Election c -> Ballot c -> Bool+verifyBallot ::+ forall crypto v c.+ Reifies v Version =>+ Reifies c crypto =>+ Group crypto =>+ Multiplicative (FieldElement crypto c) =>+ ToNatural (FieldElement crypto c) =>+ ToNatural (PublicKey crypto c) =>+ Election crypto v c ->+ Ballot crypto v c -> Bool verifyBallot Election{..} Ballot{..} =-	let elecPubKey = electionCrypto_FFC_PublicKey election_crypto in 	ballot_election_uuid == election_uuid && 	ballot_election_hash == election_hash && 	List.length election_questions == List.length ballot_answers &&@@ -706,11 +919,11 @@ 			let zkp = ZKP (bytesNat signature_publicKey) in 			(, zkp) $ 				proof_challenge signature_proof == hash-				 (signatureCommitments zkp (commitQuicker signature_proof groupGen signature_publicKey))-				 (signatureStatement ballot_answers)+				 (signatureCommitments @_ @crypto zkp (commitQuicker signature_proof groupGen signature_publicKey))+				 (signatureStatement @_ @crypto ballot_answers) 	in 	and $ isValidSign :-		List.zipWith (verifyAnswer elecPubKey zkpSign)+		List.zipWith (verifyAnswer election_public_key zkpSign) 		 election_questions ballot_answers  -- ** Type 'Signature'@@ -719,12 +932,20 @@ -- Used by each voter to sign his/her encrypted 'Ballot' -- using his/her 'Credential', -- in order to avoid ballot stuffing.-data Signature c = Signature- { signature_publicKey :: !(PublicKey c)+data Signature crypto v c = Signature+ { signature_publicKey :: !(PublicKey crypto c)    -- ^ Verification key.- , signature_proof     :: !(Proof c)- } deriving (Generic,NFData)-instance Reifies c FFC => ToJSON (Signature c) where+ , signature_proof     :: !(Proof crypto v c)+ } deriving (Generic)+deriving instance+ ( NFData crypto+ , NFData (FieldElement crypto c)+ ) => NFData (Signature crypto v c)+instance+ ( Reifies c crypto+ , Reifies v Version+ , ToJSON (FieldElement crypto c)+ ) => ToJSON (Signature crypto v c) where 	toJSON (Signature pubKey Proof{..}) = 		JSON.object 		 [ "public_key" .= pubKey@@ -737,7 +958,12 @@ 		 <> "challenge"  .= proof_challenge 		 <> "response"   .= proof_response 		 )-instance Reifies c FFC => FromJSON (Signature c) where+instance+ ( Reifies c crypto+ , Reifies v Version+ , Group crypto+ , FromJSON (PublicKey crypto c)+ ) => FromJSON (Signature crypto v c) where 	parseJSON = JSON.withObject "Signature" $ \o -> do 		signature_publicKey <- o .: "public_key" 		proof_challenge     <- o .: "challenge"@@ -750,14 +976,17 @@ -- | @('signatureStatement' answers)@ -- returns the encrypted material to be signed: -- all the 'encryption_nonce's and 'encryption_vault's of the given @answers@.-signatureStatement :: Reifies c FFC => Foldable f => f (Answer c) -> [G c]+signatureStatement :: Reifies c crypto => Foldable f => f (Answer crypto v c) -> [G crypto c] signatureStatement = 	foldMap $ \Answer{..} -> 		(`foldMap` answer_opinions) $ \(Encryption{..}, _proof) -> 			[encryption_nonce, encryption_vault]  -- | @('signatureCommitments' voterZKP commitment)@-signatureCommitments :: ZKP -> Commitment c -> BS.ByteString+signatureCommitments ::+ Reifies c crypto =>+ ToNatural (FieldElement crypto c) =>+ ZKP -> Commitment crypto c -> BS.ByteString signatureCommitments (ZKP voterZKP) commitment = 	"sig|"<>voterZKP<>"|" -- NOTE: this is actually part of the statement 	 <> bytesNat commitment<>"|"@@ -773,3 +1002,59 @@  |   ErrorBallot_Wrong      -- ^ TODO: to be more precise.  deriving (Eq,Show,Generic,NFData)++-- * Type 'Version'+-- | Version of the Helios-C protocol.+data Version = Version+ { version_branch :: [Natural]+ , version_tags   :: [(Text, Natural)]+ } deriving (Eq,Ord,Generic,NFData)+instance IsString Version where+	fromString = fromJust . readVersion+instance Show Version where+	showsPrec _p Version{..} =+		List.foldr (.) id+		 (List.intersperse (showChar '.') $+			showsPrec 0 <$> version_branch) .+		List.foldr (.) id+		 ((\(t,n) -> showChar '-' . showString (Text.unpack t) .+			if n > 0 then showsPrec 0 n else id)+		 <$> version_tags)+instance ToJSON Version where+	toJSON     = toJSON     . show+	toEncoding = toEncoding . show+instance FromJSON Version where+	parseJSON (JSON.String s)+	 | Just v <- readVersion (Text.unpack s)+	 = return v+	parseJSON json = JSON.typeMismatch "Version" json++hasVersionTag :: Version -> Text -> Bool+hasVersionTag v tag = List.any (\(t,_n) -> t == tag) (version_tags v)++experimentalVersion :: Version+experimentalVersion = stableVersion+ {version_tags = [(versionTagQuicker,0)]}++stableVersion :: Version+stableVersion = "1.6"++versionTagQuicker :: Text+versionTagQuicker = "quicker"++readVersion :: String -> Maybe Version+readVersion = parseReadP $ do+	version_branch <- Read.sepBy1+	 (Read.read <$> Read.munch1 Char.isDigit)+	 (Read.char '.')+	version_tags <- Read.many $ (,)+		 <$> (Text.pack <$ Read.char '-' <*> Read.munch1 Char.isAlpha)+		 <*> (Read.read <$> Read.munch1 Char.isDigit <|> return 0)+	return Version{..}++parseReadP :: Read.ReadP a -> String -> Maybe a+parseReadP p s =+	let p' = Read.readP_to_S p in+	listToMaybe $ do+		(x, "") <- p' s+		return x

@@ -1,63 +1,49 @@+{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE UndecidableInstances #-} -- for Reifies instances {-# OPTIONS_GHC -fno-warn-orphans #-} -- | Finite Field Cryptography (FFC) -- is a method of implementing discrete logarithm cryptography -- using finite field mathematics.-module Voting.Protocol.FFC- ( module Voting.Protocol.FFC- , Natural- , Random.RandomGen- , Reifies(..), reify- , Proxy(..)- ) where+module Voting.Protocol.FFC where  import Control.Arrow (first) import Control.DeepSeq (NFData) import Control.Monad (Monad(..), unless) import Data.Aeson (ToJSON(..),FromJSON(..),(.:),(.:?),(.=))-import Data.Bits import Data.Bool import Data.Either (Either(..)) import Data.Eq (Eq(..))-import Data.Foldable (Foldable, foldl')-import Data.Function (($), (.), id)+import Data.Function (($), (.)) import Data.Functor ((<$>))-import Data.Int (Int) import Data.Maybe (Maybe(..), fromMaybe, fromJust) import Data.Monoid (Monoid(..)) import Data.Ord (Ord(..)) import Data.Proxy (Proxy(..))-import Data.Reflection (Reifies(..), reify)+import Data.Reflection (Reifies(..)) import Data.Semigroup (Semigroup(..))-import Data.String (IsString(..)) import Data.Text (Text) import GHC.Generics (Generic) import GHC.Natural (minusNaturalMaybe) import Numeric.Natural (Natural)-import Prelude (Integer, Integral(..), fromIntegral, Enum(..))+import Prelude (Integral(..), fromIntegral) import Text.Read (readMaybe, readEither) import Text.Show (Show(..))-import qualified Control.Monad.Trans.State.Strict as S-import qualified Crypto.Hash as Crypto+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.ByteString.Base64 as BS64 import qualified Data.Char as Char-import qualified Data.List as List import qualified Data.Text as Text import qualified Data.Text.Encoding 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 +import Voting.Protocol.Arith+import Voting.Protocol.Credential+ -- * Type 'FFC' -- | Mutiplicative Sub-Group of a Finite Prime Field. --@@ -130,15 +116,14 @@ 		unless (fromJust (ffc_fieldCharac`minusNaturalMaybe`one) `rem` ffc_groupOrder == 0) $ 			JSON.typeMismatch "FFC: groupOrder does not divide fieldCharac-1" (JSON.Object o) 		return FFC{..}+instance Group FFC where+	groupGen :: forall c. Reifies c FFC => G FFC c+	groupGen = G $ F $ ffc_groupGen $ reflect (Proxy::Proxy c)+	groupOrder :: forall c. Reifies c FFC => Proxy c -> Natural+	groupOrder c = ffc_groupOrder $ reflect c  fieldCharac :: forall c. Reifies c FFC => Natural-fieldCharac = ffc_fieldCharac (reflect (Proxy::Proxy c))--groupGen :: forall c. Reifies c FFC => G c-groupGen = G $ F $ ffc_groupGen (reflect (Proxy::Proxy c))--groupOrder :: forall c. Reifies c FFC => Natural-groupOrder = ffc_groupOrder (reflect (Proxy::Proxy c))+fieldCharac = ffc_fieldCharac $ reflect (Proxy::Proxy c)  -- ** Examples -- | Weak parameters for debugging purposes only.@@ -189,8 +174,7 @@ newtype F c = F { unF :: Natural }  deriving (Eq,Ord,Show)  deriving newtype NFData-instance ToJSON (F c) where-	toJSON (F x) = JSON.toJSON (show x)+type instance FieldElement FFC = F instance Reifies c FFC => FromJSON (F c) where 	parseJSON (JSON.String s) 	 | Just (c0,_) <- Text.uncons s@@ -199,7 +183,20 @@ 	 , Just x <- readMaybe (Text.unpack s) 	 , x < fieldCharac @c 	 = return (F x)-	parseJSON json = JSON.typeMismatch "FieldElement" json+	parseJSON json = JSON.typeMismatch "FieldElement FFC" json+instance Reifies c FFC => FromJSON (G FFC c) where+	parseJSON (JSON.String s)+	 | Just (c0,_) <- Text.uncons s+	 , c0 /= '0'+	 , Text.all Char.isDigit s+	 , Just x <- readMaybe (Text.unpack s)+	 , x < fieldCharac @c+	 , r <- G (F x)+	 , r ^ E (groupOrder @FFC (Proxy @c)) == one+	 = return r+	parseJSON json = JSON.typeMismatch "GroupElement" json+instance ToJSON (F c) where+	toJSON (F x) = JSON.toJSON (show x) instance Reifies c FFC => FromNatural (F c) where 	fromNatural i = F $ abs $ i `mod` fieldCharac @c 		where@@ -227,267 +224,19 @@ 		first (F . fromIntegral) . 		Random.randomR (0, toInteger (fieldCharac @c) - 1) --- ** Class 'Additive'-class Additive a where-	zero :: a-	(+) :: a -> a -> a; infixl 6 +-	sum :: Foldable f => f a -> a-	sum = foldl' (+) zero-instance Additive Natural where-	zero = 0-	(+)  = (Num.+)-instance Additive Integer where-	zero = 0-	(+)  = (Num.+)-instance Additive Int where-	zero = 0-	(+)  = (Num.+)---- *** Class 'Negable'-class Additive a => Negable a where-	neg :: a -> a-	(-) :: a -> a -> a; infixl 6 --	x-y = x + neg y-instance Negable Integer where-	neg  = Num.negate-instance Negable Int where-	neg  = Num.negate---- ** Class 'Multiplicative'-class Multiplicative a where-	one :: a-	(*) :: a -> a -> a; infixl 7 *-instance Multiplicative Natural where-	one = 1-	(*) = (Num.*)-instance Multiplicative Integer where-	one = 1-	(*) = (Num.*)-instance Multiplicative Int where-	one = 1-	(*) = (Num.*)---- ** Class 'Invertible'-class Multiplicative a => Invertible a where-	inv :: a -> a-	(/) :: a -> a -> a; infixl 7 /-	x/y = x * inv y---- * Type 'G'--- | The type of the elements of a 'Multiplicative' subgroup of a Finite Prime Field.-newtype G c = G { unG :: F c }- deriving (Eq,Ord,Show)- deriving newtype NFData-instance ToJSON (G c) where-	toJSON (G x) = JSON.toJSON x-instance Reifies c FFC => FromJSON (G c) where-	parseJSON (JSON.String s)-	 | Just (c0,_) <- Text.uncons s-	 , c0 /= '0'-	 , Text.all Char.isDigit s-	 , Just x <- readMaybe (Text.unpack s)-	 , x < fieldCharac @c-	 , r <- G (F x)-	 , r ^ E (groupOrder @c) == one-	 = return r-	parseJSON json = JSON.typeMismatch "GroupElement" json-instance Reifies c FFC => FromNatural (G c) where-	fromNatural = G . fromNatural-instance ToNatural (G c) where-	nat = unF . unG-instance Reifies c FFC => Multiplicative (G c) where-	one = G $ F one-	G x * G y = G (x * y)-instance Reifies c FFC => Invertible (G c) where-	-- | NOTE: add 'groupOrder' so the exponent given to (^) is positive.-	inv = (^ E (fromJust $ groupOrder @c`minusNaturalMaybe`1))---- | 'groupGenInverses' returns the infinite list--- of 'inv'erse powers of 'groupGen':--- @['groupGen' '^' 'neg' i | i <- [0..]]@,--- but by computing each value from the previous one.------ Used by 'intervalDisjunctions'.-groupGenInverses :: forall c. Reifies c FFC => [G c]-groupGenInverses = go one-	where-	invGen = inv $ groupGen @c-	go g = g : go (g * invGen)--groupGenPowers :: forall c. Reifies c FFC => [G c]-groupGenPowers = go one-	where go g = g : go (g * groupGen @c)---- ** Type 'Hash'-newtype Hash c = Hash (E c)- deriving (Eq,Ord,Show)- deriving newtype NFData---- | @('hash' bs gs)@ returns as a number in 'E'--- 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.------ 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 :: Reifies c FFC => BS.ByteString -> [G c] -> E c-hash bs gs = do-	let s = bs <> BS.intercalate (fromString ",") (bytesNat <$> gs)-	let h = Crypto.hashWith Crypto.SHA256 s-	fromNatural $-		decodeBigEndian $ ByteArray.convert h---- | @('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 'Base64SHA256'-newtype Base64SHA256 = Base64SHA256 Text- deriving (Eq,Ord,Show,Generic)- deriving anyclass (ToJSON,FromJSON)- deriving newtype NFData---- | @('base64SHA256' bs)@ returns the 'Crypto.SHA256' hash--- of the given 'BS.ByteString' 'bs',--- as a 'Text' escaped in @base64@ encoding--- (<https://tools.ietf.org/html/rfc4648 RFC 4648>).-base64SHA256 :: BS.ByteString -> Base64SHA256-base64SHA256 bs =-	let h = Crypto.hashWith Crypto.SHA256 bs in-	Base64SHA256 $-		Text.takeWhile (/= '=') $ -- NOTE: no padding.-		Text.decodeUtf8 $ BS64.encode $ ByteArray.convert h---- ** Type 'HexSHA256'-newtype HexSHA256 = HexSHA256 Text- deriving (Eq,Ord,Show,Generic)- deriving anyclass (ToJSON,FromJSON)- deriving newtype NFData--- | @('hexSHA256' 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.-hexSHA256 :: BS.ByteString -> Text-hexSHA256 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---- * Type 'E'--- | An exponent of a (necessarily cyclic) subgroup of a Finite Prime Field.--- The value is always in @[0..'groupOrder'-1]@.-newtype E c = E { unE :: Natural }- deriving (Eq,Ord,Show)- deriving newtype NFData-instance ToJSON (E c) where-	toJSON (E x) = JSON.toJSON (show x)-instance Reifies c FFC => FromJSON (E c) where-	parseJSON (JSON.String s)-	 | Just (c0,_) <- Text.uncons s-	 , c0 /= '0'-	 , Text.all Char.isDigit s-	 , Just x <- readMaybe (Text.unpack s)-	 , x < groupOrder @c-	 = return (E x)-	parseJSON json = JSON.typeMismatch "Exponent" json--instance Reifies c FFC => FromNatural (E c) where-	fromNatural i =-		E $ abs $ i `mod` groupOrder @c-		where-		abs x | x < 0 = x + groupOrder @c-		      | otherwise = x-instance ToNatural (E c) where-	nat = unE--instance Reifies c FFC => Additive (E c) where-	zero = E zero-	E x + E y = E $ (x + y) `mod` groupOrder @c-instance Reifies c FFC => Negable (E c) where-	neg (E x)-	 | x == 0 = zero-	 | otherwise = E $ fromJust $ nat (groupOrder @c)`minusNaturalMaybe`x-instance Reifies c FFC => Multiplicative (E c) where-	one = E one-	E x * E y = E $ (x * y) `mod` groupOrder @c-instance Reifies c FFC => Random.Random (E c) where-	randomR (E lo, E hi) =-		first (E . fromIntegral) .-		Random.randomR-		 ( 0`max`toInteger lo-		 , toInteger hi`min`(toInteger (groupOrder @c) - 1) )-	random =-		first (E . fromIntegral) .-		Random.randomR (0, toInteger (groupOrder @c) - 1)-instance Reifies c FFC => Enum (E c) where-	toEnum = fromNatural . fromIntegral-	fromEnum = fromIntegral . nat-	enumFromTo lo hi = List.unfoldr-	 (\i -> if i<=hi then Just (i, i+one) else Nothing) lo--infixr 8 ^--- | @(b '^' e)@ returns the modular exponentiation of base 'b' by exponent 'e'.-(^) :: Reifies c FFC => G c -> E c -> G c-(^) b (E e)- | e == 0 = one- | otherwise = t * (b*b) ^ E (e`shiftR`1)-	where-	t | testBit e 0 = b-	  | otherwise   = one---- | @('randomR' i)@ returns a random integer in @[0..i-1]@.-randomR ::- Monad m =>- Random.RandomGen r =>- Random.Random i =>- Negable i =>- Multiplicative i =>- i -> S.StateT r m i-randomR i = S.StateT $ return . Random.randomR (zero, i-one)---- | @('random')@ returns a random integer--- in the range determined by its type.-random ::- Monad m =>- Random.RandomGen r =>- Random.Random i =>- Negable i =>- Multiplicative i =>- S.StateT r m i-random = S.StateT $ return . Random.random--instance Random.Random Natural where-	randomR (mini,maxi) =-		first (fromIntegral::Integer -> Natural) .-		Random.randomR (fromIntegral mini, fromIntegral maxi)-	random = first (fromIntegral::Integer -> Natural) . Random.random- -- * Conversions --- ** Class 'FromNatural'-class FromNatural a where-	fromNatural :: Natural -> a---- ** Class 'ToNatural'-class ToNatural a where-	nat :: a -> Natural-instance ToNatural Natural where-	nat = id---- | @('bytesNat' x)@ returns the serialization of 'x'.-bytesNat :: ToNatural n => n -> BS.ByteString-bytesNat = fromString . show . nat+instance Key FFC where+	cryptoType _ = "FFC"+	cryptoName = ffc_name+	randomSecretKey = random+	credentialSecretKey (UUID uuid) (Credential cred) =+		fromNatural $ decodeBigEndian $+		Crypto.fastPBKDF2_SHA256+		 Crypto.Parameters+		 { Crypto.iterCounts   = 1000+		 , Crypto.outputLength = 32 -- bytes, ie. 256 bits+		 }+		 (Text.encodeUtf8 cred)+		 (Text.encodeUtf8 uuid)+	publicKey = (groupGen @FFC ^)

@@ -14,9 +14,12 @@ import Data.Functor ((<$>)) import Data.Maybe (maybe) import Data.Semigroup (Semigroup(..))+import Data.Ord (Ord(..))+import Data.Reflection (Reifies(..)) import Data.Tuple (fst, snd) import GHC.Generics (Generic) import Numeric.Natural (Natural)+import System.Random (RandomGen) import Text.Show (Show(..)) import qualified Data.Aeson as JSON import qualified Data.Aeson.Types as JSON@@ -27,12 +30,12 @@ import qualified Data.Map.Strict as Map  import Voting.Protocol.Utils-import Voting.Protocol.FFC+import Voting.Protocol.Arith import Voting.Protocol.Credential import Voting.Protocol.Election  -- * Type 'Tally'-data Tally c = Tally+data Tally crypto v c = Tally  { tally_countMax :: !Natural    -- ^ The maximal number of supportive 'Opinion's that a choice can get,    -- which is here the same as the number of 'Ballot's.@@ -40,14 +43,22 @@    -- Used in 'proveTally' to decrypt the actual    -- count of votes obtained by a choice,    -- by precomputing all powers of 'groupGen's up to it.- , tally_encByChoiceByQuest :: !(EncryptedTally c)+ , tally_encByChoiceByQuest :: !(EncryptedTally crypto v c)    -- ^ 'Encryption' by 'Question' by 'Ballot'.- , tally_decShareByTrustee :: ![DecryptionShare c]+ , tally_decShareByTrustee :: ![DecryptionShare crypto v c]    -- ^ 'DecryptionShare' by trustee.  , tally_countByChoiceByQuest :: ![[Natural]]    -- ^ The decrypted count of supportive 'Opinion's, by choice by 'Question'.- } deriving (Eq,Show,Generic,NFData)-instance Reifies c FFC => ToJSON (Tally c) where+ } deriving (Generic)+deriving instance Eq (FieldElement crypto c) => Eq (Tally crypto v c)+deriving instance (Show (FieldElement crypto c), Show (G crypto c)) => Show (Tally crypto v c)+deriving instance NFData (FieldElement crypto c) => NFData (Tally crypto v c)+instance+ ( Reifies v Version+ , Reifies c crypto+ , Group crypto+ , ToJSON (FieldElement crypto c)+ ) => ToJSON (Tally crypto v c) where 	toJSON Tally{..} = 		JSON.object 		 [ "num_tallied"         .= tally_countMax@@ -62,7 +73,12 @@ 		 <> "partial_decryptions" .= tally_decShareByTrustee 		 <> "result"              .= tally_countByChoiceByQuest 		 )-instance Reifies c FFC => FromJSON (Tally c) where+instance+ ( Reifies v Version+ , Reifies c crypto+ , Group crypto+ , FromJSON (G crypto c)+ ) => FromJSON (Tally crypto v c) where 	parseJSON = JSON.withObject "Tally" $ \o -> do 		tally_countMax             <- o .: "num_tallied" 		tally_encByChoiceByQuest   <- o .: "encrypted_tally"@@ -72,22 +88,31 @@  -- ** Type 'EncryptedTally' -- | 'Encryption' by choice by 'Question'.-type EncryptedTally c = [[Encryption c]]+type EncryptedTally crypto v c = [[Encryption crypto v c]]  -- | @('encryptedTally' ballots)@ -- 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 ::+ Reifies c crypto =>+ Multiplicative (FieldElement crypto c) =>+ [Ballot crypto v c] -> (EncryptedTally crypto v c, Natural) encryptedTally = List.foldr insertEncryptedTally emptyEncryptedTally  -- | The initial 'EncryptedTally' which tallies no 'Ballot'.-emptyEncryptedTally :: Reifies c FFC => (EncryptedTally c, Natural)+emptyEncryptedTally ::+ Reifies c crypto =>+ Multiplicative (FieldElement crypto c) =>+ (EncryptedTally crypto v 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 ::+ Reifies c crypto =>+ Multiplicative (FieldElement crypto c) =>+ Ballot crypto v c -> (EncryptedTally crypto v c, Natural) -> (EncryptedTally crypto v c, Natural) insertEncryptedTally Ballot{..} (encTally, numBallots) = 	( List.zipWith 		 (\Answer{..} -> List.zipWith (+) (fst <$> answer_opinions))@@ -97,14 +122,19 @@ 	)  -- ** Type 'DecryptionShareCombinator'-type DecryptionShareCombinator c =-	EncryptedTally c -> [DecryptionShare c] -> Except ErrorTally [[DecryptionFactor c]]+type DecryptionShareCombinator crypto v c =+ EncryptedTally crypto v c ->+ [DecryptionShare crypto v c] ->+ Except ErrorTally [[DecryptionFactor crypto c]]  proveTally ::- Reifies c FFC =>- (EncryptedTally c, Natural) -> [DecryptionShare c] ->- DecryptionShareCombinator c ->- Except ErrorTally (Tally c)+ Reifies c crypto =>+ Group crypto =>+ Multiplicative (FieldElement crypto c) =>+ Ord (FieldElement crypto c) =>+ (EncryptedTally crypto v c, Natural) -> [DecryptionShare crypto v c] ->+ DecryptionShareCombinator crypto v c ->+ Except ErrorTally (Tally crypto v c) proveTally  (tally_encByChoiceByQuest, tally_countMax)  tally_decShareByTrustee@@ -126,8 +156,12 @@ 	return Tally{..}  verifyTally ::- Reifies c FFC =>- Tally c -> DecryptionShareCombinator c ->+ Reifies c crypto =>+ Group crypto =>+ Multiplicative (FieldElement crypto c) =>+ Eq (FieldElement crypto c) =>+ Tally crypto v c ->+ DecryptionShareCombinator crypto v c ->  Except ErrorTally () verifyTally Tally{..} decShareCombinator = do 	decFactorByChoiceByQuest <- decShareCombinator tally_encByChoiceByQuest tally_decShareByTrustee@@ -144,11 +178,16 @@ -- ** Type 'DecryptionShare' -- | A decryption share is a 'DecryptionFactor' and a decryption 'Proof', by choice by 'Question'. -- Computed by a trustee in 'proveDecryptionShare'.-newtype DecryptionShare c = DecryptionShare- { unDecryptionShare :: [[(DecryptionFactor c, Proof c)]] }- deriving (Eq,Show,Generic)-deriving newtype instance NFData (DecryptionShare c)-instance ToJSON (DecryptionShare c) where+newtype DecryptionShare crypto v c = DecryptionShare+ { unDecryptionShare :: [[(DecryptionFactor crypto c, Proof crypto v c)]] }+ deriving (Generic)+deriving instance Eq (FieldElement crypto c) => Eq (DecryptionShare crypto v c)+deriving instance Show (G crypto c) => Show (DecryptionShare crypto v c)+deriving newtype instance NFData (FieldElement crypto c) => NFData (DecryptionShare crypto v c)+instance+ ( Group crypto+ , ToJSON (FieldElement crypto c)+ ) => ToJSON (DecryptionShare crypto v c) where 	toJSON (DecryptionShare decByChoiceByQuest) = 		JSON.object 		 [ "decryption_factors" .=@@ -162,7 +201,11 @@ 			 (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+instance+ ( Reifies c crypto+ , Group crypto+ , FromJSON (G crypto c)+ ) => FromJSON (DecryptionShare crypto v c) where 	parseJSON = JSON.withObject "DecryptionShare" $ \o -> do 		decFactors <- o .: "decryption_factors" 		decProofs  <- o .: "decryption_proofs"@@ -179,21 +222,36 @@  -- @('proveDecryptionShare' encByChoiceByQuest trusteeSecKey)@ proveDecryptionShare ::- Monad m => Reifies c FFC => RandomGen r =>- EncryptedTally c -> SecretKey c -> S.StateT r m (DecryptionShare c)+ Reifies v Version =>+ Reifies c crypto =>+ Group crypto =>+ Multiplicative (FieldElement crypto c) =>+ Key crypto =>+ ToNatural (FieldElement crypto c) =>+ Monad m => RandomGen r =>+ EncryptedTally crypto v c -> SecretKey crypto c -> S.StateT r m (DecryptionShare crypto v c) proveDecryptionShare encByChoiceByQuest trusteeSecKey = 	(DecryptionShare <$>) $ 	(proveDecryptionFactor trusteeSecKey `mapM`) `mapM` encByChoiceByQuest  proveDecryptionFactor ::- Monad m => Reifies c FFC => RandomGen r =>- SecretKey c -> Encryption c -> S.StateT r m (DecryptionFactor c, Proof c)+ Reifies v Version => + Reifies c crypto => + Group crypto =>+ Multiplicative (FieldElement crypto c) =>+ Key crypto =>+ ToNatural (FieldElement crypto c) =>+ Monad m => RandomGen r =>+ SecretKey crypto c -> Encryption crypto v c -> S.StateT r m (DecryptionFactor crypto c, Proof crypto v c) proveDecryptionFactor trusteeSecKey Encryption{..} = do 	proof <- prove trusteeSecKey [groupGen, encryption_nonce] (hash zkp) 	return (encryption_nonce^trusteeSecKey, proof) 	where zkp = decryptionShareStatement (publicKey trusteeSecKey) -decryptionShareStatement :: Reifies c FFC => PublicKey c -> BS.ByteString+decryptionShareStatement ::+ Reifies c crypto =>+ ToNatural (FieldElement crypto c) =>+ PublicKey crypto c -> BS.ByteString decryptionShareStatement pubKey = 	"decrypt|"<>bytesNat pubKey<>"|" @@ -218,8 +276,13 @@ -- (supposedly submitted by a trustee whose 'PublicKey' is 'trusteePubKey') -- is valid with respect to the 'EncryptedTally' 'encTally'. verifyDecryptionShare ::- Monad m => Reifies c FFC =>- EncryptedTally c -> PublicKey c -> DecryptionShare c ->+ Reifies v Version =>+ Reifies c crypto =>+ Group crypto =>+ Multiplicative (FieldElement crypto c) =>+ ToNatural (FieldElement crypto c) =>+ Monad m =>+ EncryptedTally crypto v c -> PublicKey crypto c -> DecryptionShare crypto v c ->  ExceptT ErrorTally m () verifyDecryptionShare encByChoiceByQuest trusteePubKey (DecryptionShare decShare) = 	let zkp = decryptionShareStatement trusteePubKey in@@ -234,8 +297,13 @@ 	 decShare  verifyDecryptionShareByTrustee ::- Monad m => Reifies c FFC =>- EncryptedTally c -> [PublicKey c] -> [DecryptionShare c] ->+ Reifies v Version =>+ Reifies c crypto =>+ Group crypto =>+ Multiplicative (FieldElement crypto c) =>+ ToNatural (FieldElement crypto c) =>+ Monad m =>+ EncryptedTally crypto v c -> [PublicKey crypto c] -> [DecryptionShare crypto v c] ->  ExceptT ErrorTally m () verifyDecryptionShareByTrustee encTally = 	isoZipWithM_ (throwE ErrorTally_NumberOfTrustees)

@@ -12,9 +12,11 @@ import Data.Function (($)) import Data.Functor ((<$>)) import Data.Maybe (maybe)+import Data.Reflection (Reifies(..)) import Data.Semigroup (Semigroup(..)) import Data.Tuple (fst) import GHC.Generics (Generic)+import System.Random (RandomGen) import Text.Show (Show(..)) import qualified Control.Monad.Trans.State.Strict as S import qualified Data.Aeson as JSON@@ -22,15 +24,15 @@ import qualified Data.List as List  import Voting.Protocol.Utils-import Voting.Protocol.FFC+import Voting.Protocol.Arith import Voting.Protocol.Credential import Voting.Protocol.Election import Voting.Protocol.Tally  -- * Type 'TrusteePublicKey'-data TrusteePublicKey c = TrusteePublicKey- { trustee_PublicKey      :: !(PublicKey c)- , trustee_SecretKeyProof :: !(Proof c)+data TrusteePublicKey crypto v c = TrusteePublicKey+ { trustee_PublicKey      :: !(PublicKey crypto c)+ , trustee_SecretKeyProof :: !(Proof crypto v c) 	-- ^ NOTE: It is important to ensure 	-- that each trustee generates its key pair independently 	-- of the 'PublicKey's published by the other trustees.@@ -44,8 +46,14 @@ 	-- must 'prove' knowledge of the corresponding 'SecretKey'. 	-- Which is done in 'proveIndispensableTrusteePublicKey' 	-- and 'verifyIndispensableTrusteePublicKey'.- } deriving (Eq,Show,Generic,NFData)-instance ToJSON (TrusteePublicKey c) where+ } deriving (Generic)+deriving instance Eq (FieldElement crypto c) => Eq (TrusteePublicKey crypto v c)+deriving instance (Show (FieldElement crypto c), Show (PublicKey crypto c)) => Show (TrusteePublicKey crypto v c)+deriving instance NFData (FieldElement crypto c) => NFData (TrusteePublicKey crypto v c)+instance+ ( Group crypto+ , ToJSON (FieldElement crypto c)+ ) => ToJSON (TrusteePublicKey crypto v c) where 	toJSON TrusteePublicKey{..} = 		JSON.object 		 [ "pok"        .= trustee_SecretKeyProof@@ -56,7 +64,11 @@ 		 (  "pok"        .= trustee_SecretKeyProof 		 <> "public_key" .= trustee_PublicKey 		 )-instance Reifies c FFC => FromJSON (TrusteePublicKey c) where+instance+ ( Reifies c crypto+ , Group crypto+ , FromJSON (PublicKey crypto c)+ ) => FromJSON (TrusteePublicKey crypto v c) where 	parseJSON = JSON.withObject "TrusteePublicKey" $ \o -> do 		trustee_PublicKey <- o .: "public_key" 		trustee_SecretKeyProof <- o .: "pok"@@ -68,8 +80,14 @@ -- returns the 'PublicKey' associated to 'trustSecKey' -- and a 'Proof' of its knowledge. proveIndispensableTrusteePublicKey ::- Reifies c FFC => Monad m => RandomGen r =>- SecretKey c -> S.StateT r m (TrusteePublicKey c)+ Reifies v Version =>+ Reifies c crypto =>+ Group crypto =>+ Key crypto =>+ Multiplicative (FieldElement crypto c) =>+ ToNatural (FieldElement crypto c) =>+ Monad m => RandomGen r =>+ SecretKey crypto c -> S.StateT r m (TrusteePublicKey crypto v c) proveIndispensableTrusteePublicKey trustSecKey = do 	let trustee_PublicKey = publicKey trustSecKey 	trustee_SecretKeyProof <-@@ -84,8 +102,13 @@ -- does 'prove' that the 'SecretKey' associated with -- the given 'trustee_PublicKey' is known by the trustee. verifyIndispensableTrusteePublicKey ::- Reifies c FFC => Monad m =>- TrusteePublicKey c ->+ Reifies v Version =>+ Reifies c crypto =>+ Group crypto =>+ Multiplicative (FieldElement crypto c) =>+ ToNatural (FieldElement crypto c) =>+ Monad m =>+ TrusteePublicKey crypto v c ->  ExceptT ErrorTrusteePublicKey m () verifyIndispensableTrusteePublicKey TrusteePublicKey{..} = 	unless (@@ -102,7 +125,10 @@  deriving (Eq,Show)  -- ** Hashing-indispensableTrusteePublicKeyStatement :: PublicKey c -> BS.ByteString+indispensableTrusteePublicKeyStatement ::+ Reifies c crypto =>+ ToNatural (FieldElement crypto c) =>+ PublicKey crypto c -> BS.ByteString indispensableTrusteePublicKeyStatement trustPubKey = 	"pok|"<>bytesNat trustPubKey<>"|" @@ -111,15 +137,23 @@ -- ** Generating an 'Election''s 'PublicKey' from multiple 'TrusteePublicKey's.  combineIndispensableTrusteePublicKeys ::- Reifies c FFC => [TrusteePublicKey c] -> PublicKey c+ Reifies c crypto =>+ Multiplicative (FieldElement crypto c) =>+ ToNatural (FieldElement crypto c) =>+ [TrusteePublicKey crypto v c] -> PublicKey crypto c combineIndispensableTrusteePublicKeys = 	List.foldr (\TrusteePublicKey{..} -> (trustee_PublicKey *)) one  -- ** Checking the trustee's 'DecryptionShare's before decrypting an 'EncryptedTally'.  verifyIndispensableDecryptionShareByTrustee ::- Reifies c FFC => Monad m =>- EncryptedTally c -> [PublicKey c] -> [DecryptionShare c] ->+ Reifies v Version =>+ Reifies c crypto =>+ Group crypto =>+ Multiplicative (FieldElement crypto c) =>+ ToNatural (FieldElement crypto c) =>+ Monad m =>+ EncryptedTally crypto v c -> [PublicKey crypto c] -> [DecryptionShare crypto v c] ->  ExceptT ErrorTally m () verifyIndispensableDecryptionShareByTrustee encByChoiceByQuest = 	isoZipWithM_ (throwE $ ErrorTally_NumberOfTrustees)@@ -130,7 +164,12 @@ -- | @('combineDecryptionShares' pubKeyByTrustee decShareByTrustee)@ -- returns the 'DecryptionFactor's by choice by 'Question' combineIndispensableDecryptionShares ::- Reifies c FFC => [PublicKey c] -> DecryptionShareCombinator c+ Reifies v Version =>+ Reifies c crypto =>+ Group crypto =>+ Multiplicative (FieldElement crypto c) =>+ ToNatural (FieldElement crypto c) =>+ [PublicKey crypto c] -> DecryptionShareCombinator crypto v c combineIndispensableDecryptionShares  pubKeyByTrustee  encByChoiceByQuest

@@ -2,12 +2,16 @@  import Control.Applicative (Applicative(..)) import Data.Bool+import Data.Either (Either(..), either) import Data.Eq (Eq(..)) import Data.Foldable (sequenceA_)-import Data.Function (($))+import Data.Function (($), (.)) import Data.Functor ((<$)) import Data.Maybe (Maybe(..), maybe)+import Data.String (String) import Data.Traversable (Traversable(..))+import Data.Tuple (uncurry)+import qualified Data.Aeson.Internal as JSON import qualified Data.List as List  -- | Like ('.') but with two arguments.@@ -58,3 +62,8 @@ 	maybe err sequenceA_ $ 		isoZipWith3 f as bs cs +-- | Copied from 'Data.Aeson''s 'eitherFormatError'+-- which is not exported.+jsonEitherFormatError :: Either (JSON.JSONPath, String) a -> Either String a+jsonEitherFormatError = either (Left . uncurry JSON.formatError) Right+{-# INLINE jsonEitherFormatError #-}

@@ -1,15 +1,16 @@ module HUnit where import Test.Tasty+import Voting.Protocol import qualified HUnit.FFC import qualified HUnit.Credential import qualified HUnit.Election import qualified HUnit.Trustee -hunits :: TestTree-hunits =+hunits :: Reifies v Version => Proxy v -> TestTree+hunits v = 	testGroup "HUnit"-	 [ HUnit.FFC.hunit-	 , HUnit.Credential.hunit-	 , HUnit.Election.hunit-	 , HUnit.Trustee.hunit+	 [ HUnit.FFC.hunit v+	 , HUnit.Credential.hunit v+	 , HUnit.Election.hunit v+	 , HUnit.Trustee.hunit v 	 ]

@@ -8,8 +8,8 @@ import Voting.Protocol import Utils -hunit :: TestTree-hunit = testGroup "Credential"+hunit :: Reifies v Version => Proxy v -> TestTree+hunit _v = testGroup "Credential"  [ testGroup "randomCredential" 	 [ testCase "0" $ 		S.evalState randomCredential (Random.mkStdGen 0) @?=@@ -42,8 +42,11 @@ 	 ]  ] -testSecretKey :: FFC -> UUID -> Credential -> Natural -> TestTree-testSecretKey ffc uuid cred exp =-	reify ffc $ \(Proxy::Proxy c) ->+testSecretKey ::+ ReifyCrypto crypto =>+ Key crypto =>+ crypto -> UUID -> Credential -> Natural -> TestTree+testSecretKey crypto uuid cred exp =+	reifyCrypto crypto $ \(Proxy::Proxy c) -> 	testCase (show (uuid,cred)) $-		credentialSecretKey @c uuid cred @?= E exp+		credentialSecretKey @_ @c uuid cred @?= E exp

@@ -4,6 +4,7 @@ module HUnit.Election where  import Test.Tasty.HUnit+import qualified Data.Aeson as JSON import qualified Data.List as List import qualified Data.Text as Text import qualified System.Random as Random@@ -12,60 +13,65 @@  import Utils -hunit :: TestTree-hunit = testGroup "Election"+hunit :: Reifies v Version => Proxy v -> TestTree+hunit v = testGroup "Election" $  [ testGroup "groupGenInverses" 	 [ testCase "WeakParams" $ 		reify weakFFC $ \(Proxy::Proxy c) ->-			List.take 10 (groupGenInverses @c) @?=+			List.take 10 (groupGenInverses @_ @c) @?= 				[groupGen^neg (fromNatural n) | n <- [0..9]] 	 , testCase "BeleniosParams" $ 		reify beleniosFFC $ \(Proxy::Proxy c) ->-			List.take 10 (groupGenInverses @c) @?=+			List.take 10 (groupGenInverses @_ @c) @?= 				[groupGen^neg (fromNatural n) | n <- [0..9]] 	 ]  , testGroup "encryptBallot" $-	 [ testsEncryptBallot weakFFC-	 , testsEncryptBallot beleniosFFC+	 [ hunitsEncryptBallot v weakFFC+	 , hunitsEncryptBallot v beleniosFFC 	 ]  ] -testsEncryptBallot :: FFC -> TestTree-testsEncryptBallot ffc =-	testGroup (Text.unpack $ ffc_name ffc)-	 [ testEncryptBallot ffc 0+hunitsEncryptBallot ::+ ReifyCrypto crypto =>+ JSON.ToJSON crypto =>+ Key crypto =>+ Reifies v Version => Proxy v ->+ crypto -> TestTree+hunitsEncryptBallot v crypto =+	testGroup (Text.unpack $ cryptoName crypto)+	 [ hunitEncryptBallot v crypto 0 		 [Question "q1" ["a1","a2","a3"] zero one] 		 [[True, False, False]] 		 (Right True)-	 , testEncryptBallot ffc 0+	 , hunitEncryptBallot v crypto 0 		 [Question "q1" ["a1","a2","a3"] zero one] 		 [[False, False, False]] 		 (Right True)-	 , testEncryptBallot ffc 0+	 , hunitEncryptBallot v crypto 0 		 [Question "q1" ["a1","a2","a3"] zero one] 		 [[False, False, False]] 		 (Right True)-	 , testEncryptBallot ffc 0+	 , hunitEncryptBallot v crypto 0 		 [Question "q1" [] zero one] 		 [] 		 (Left (ErrorBallot_WrongNumberOfAnswers 0 1))-	 , testEncryptBallot ffc 0+	 , hunitEncryptBallot v crypto 0 		 [Question "q1" ["a1","a2"] one one] 		 [[True]] 		 (Left (ErrorBallot_Answer (ErrorAnswer_WrongNumberOfOpinions 1 2)))-	 , testEncryptBallot ffc 0+	 , hunitEncryptBallot v crypto 0 		 [Question "q1" ["a1","a2","a3"] zero one] 		 [[True, True, False]] 		 (Left (ErrorBallot_Answer (ErrorAnswer_WrongSumOfOpinions 2 0 1)))-	 , testEncryptBallot ffc 0+	 , hunitEncryptBallot v crypto 0 		 [Question "q1" ["a1","a2","a3"] one one] 		 [[False, False, False]] 		 (Left (ErrorBallot_Answer (ErrorAnswer_WrongSumOfOpinions 0 1 1)))-	 , testEncryptBallot ffc 0+	 , hunitEncryptBallot v crypto 0 		 [Question "q1" ["a1","a2"] one one] 		 [[False, False, True]] 		 (Left (ErrorBallot_Answer (ErrorAnswer_WrongNumberOfOpinions 3 2)))-	 , testEncryptBallot ffc 0+	 , hunitEncryptBallot v crypto 0 		 [ Question "q1" ["a11","a12","a13"] zero (one+one) 		 , Question "q2" ["a21","a22","a23"] one one 		 ]@@ -74,26 +80,29 @@ 		 (Right True) 	 ] -testEncryptBallot ::- FFC -> Int -> [Question] -> [[Bool]] ->+hunitEncryptBallot ::+ ReifyCrypto crypto =>+ JSON.ToJSON crypto =>+ Key crypto =>+ Reifies v Version => Proxy v ->+ crypto -> Int -> [Question v] -> [[Bool]] ->  Either ErrorBallot Bool ->  TestTree-testEncryptBallot ffc seed quests opins exp =+hunitEncryptBallot v election_crypto seed election_questions opins exp = 	let got =-		reify ffc $ \(Proxy::Proxy c) ->+		reifyCrypto election_crypto $ \(Proxy::Proxy c) -> 		runExcept $ 		(`evalStateT` Random.mkStdGen seed) $ do-			uuid <- randomUUID+			election_uuid <- randomUUID 			cred <- randomCredential-			let ballotSecKey = credentialSecretKey @c uuid cred-			elecPubKey <- publicKey <$> randomSecretKey+			let ballotSecKey = credentialSecretKey @_ @c election_uuid cred+			election_public_key <- publicKey <$> randomSecretKey 			let elec = Election 				 { election_name        = "election" 				 , election_description = "description"-				 , election_crypto      = ElectionCrypto_FFC ffc elecPubKey-				 , election_questions   = quests-				 , election_uuid        = uuid 				 , election_hash        = hashElection elec+				 , election_version     = Just (reflect v)+				 , .. 				 } 			verifyBallot elec 			 <$> encryptBallot elec (Just ballotSecKey) opins

@@ -6,41 +6,45 @@ import Test.Tasty.HUnit import Voting.Protocol import Utils+import qualified Data.Text as Text -hunit :: TestTree-hunit = testGroup "FFC"+hunit :: Reifies v Version => Proxy v -> TestTree+hunit _v = testGroup "FFC"  [ testGroup "inv"-	 [ testGroup "WeakParams"-		 [ testCase "groupGen" $-			reify weakFFC $ \(Proxy::Proxy c) ->-				inv (groupGen @c) @?=-					groupGen ^ E (fromJust $ groupOrder @c `minusNaturalMaybe` one)-		 ]-	 , testGroup "BeleniosParams"-		 [ testCase "groupGen" $-			reify beleniosFFC $ \(Proxy::Proxy c) ->-				inv (groupGen @c) @?=-					groupGen ^ E (fromJust $ groupOrder @c `minusNaturalMaybe` one)-		 ]+	 [ hunitInv weakFFC+	 , hunitInv beleniosFFC 	 ]  , testGroup "hash" 	 [ testGroup "WeakParams" $ 		reify weakFFC $ \(Proxy::Proxy c) -> 		 [ testCase "[groupGen]" $-			hash "start" [groupGen @c] @?=+			hash "start" [groupGen :: G FFC c] @?= 				fromNatural 62 		 , testCase "[groupGen, groupGen]" $-			hash "start" [groupGen @c, groupGen] @?=+			hash "start" [groupGen :: G FFC c, groupGen] @?= 				fromNatural 31 		 ] 	 , testGroup "BeleniosParams" $ 		reify beleniosFFC $ \(Proxy::Proxy c) -> 		 [ testCase "[groupGen]" $-			hash "start" [groupGen @c] @?=+			hash "start" [groupGen :: G FFC c] @?= 				fromNatural 75778590284190557660612328423573274641033882642784670156837892421285248292707 		 , testCase "[groupGen, groupGen]" $-			hash "start" [groupGen @c, groupGen] @?=+			hash "start" [groupGen :: G FFC c, groupGen] @?= 				fromNatural 28798937720387703653439047952832768487958170248947132321730024269734141660223 		 ] 	 ]  ]++hunitInv ::+ forall crypto.+ ReifyCrypto crypto =>+ Key crypto =>+ crypto -> TestTree+hunitInv crypto =+	testGroup (Text.unpack $ cryptoName crypto)+	 [ testCase "groupGen" $+			reifyCrypto crypto $ \(_c::Proxy c) ->+			inv (groupGen :: G crypto c) @?=+				groupGen ^ E (fromJust $ groupOrder (Proxy @c) `minusNaturalMaybe` one)+	 ]

@@ -1,9 +1,10 @@ module HUnit.Trustee where import Test.Tasty+import Voting.Protocol import qualified HUnit.Trustee.Indispensable -hunit :: TestTree-hunit =+hunit :: Reifies v Version => Proxy v -> TestTree+hunit v = 	testGroup "Trustee"-	 [ HUnit.Trustee.Indispensable.hunit+	 [ HUnit.Trustee.Indispensable.hunit v 	 ]

@@ -12,61 +12,77 @@  import Utils -hunit :: TestTree-hunit = testGroup "Indispensable"+hunit :: Reifies v Version => Proxy v -> TestTree+hunit v = testGroup "Indispensable" $  [ testGroup "verifyIndispensableTrusteePublicKey" $-	 [ testsVerifyIndispensableTrusteePublicKey weakFFC+	 [ testsVerifyIndispensableTrusteePublicKey v weakFFC 	 ]  , testGroup "verifyTally" $-	 [ testsVerifyTally weakFFC-	 , testsVerifyTally beleniosFFC+	 [ testsVerifyTally v weakFFC+	 , testsVerifyTally v beleniosFFC 	 ]  ] -testsVerifyIndispensableTrusteePublicKey :: FFC -> TestTree-testsVerifyIndispensableTrusteePublicKey ffc =-	testGroup (Text.unpack $ ffc_name ffc)-	 [ testVerifyIndispensableTrusteePublicKey ffc 0 (Right ())+testsVerifyIndispensableTrusteePublicKey ::+ ReifyCrypto crypto =>+ Reifies v Version => Proxy v ->+ crypto -> TestTree+testsVerifyIndispensableTrusteePublicKey v crypto =+	testGroup (Text.unpack $ cryptoName crypto)+	 [ testVerifyIndispensableTrusteePublicKey v crypto 0 (Right ()) 	 ]  testVerifyIndispensableTrusteePublicKey ::- FFC -> Int -> Either ErrorTrusteePublicKey () -> TestTree-testVerifyIndispensableTrusteePublicKey ffc seed exp =+ forall crypto v.+ ReifyCrypto crypto =>+ Reifies v Version => Proxy v ->+ crypto -> Int -> Either ErrorTrusteePublicKey () -> TestTree+testVerifyIndispensableTrusteePublicKey (_v::Proxy v) crypto seed exp =+	reifyCrypto crypto $ \(Proxy::Proxy c) -> 	let got =-		reify ffc $ \(Proxy::Proxy c) -> 		runExcept $ 		(`evalStateT` Random.mkStdGen seed) $ do-			trusteeSecKey :: SecretKey c <- randomSecretKey-			trusteePubKey <- proveIndispensableTrusteePublicKey trusteeSecKey+			trusteeSecKey :: SecretKey crypto c <- randomSecretKey+			trusteePubKey :: TrusteePublicKey crypto v c <- proveIndispensableTrusteePublicKey trusteeSecKey 			lift $ verifyIndispensableTrusteePublicKey trusteePubKey 	in-	testCase (Text.unpack $ ffc_name ffc) $+	testCase (Text.unpack $ cryptoName crypto) $ 		got @?= exp -testsVerifyTally :: FFC -> TestTree-testsVerifyTally ffc =-	testGroup (Text.unpack $ ffc_name ffc)-	 [ testVerifyTally ffc 0 1 1 1-	 , testVerifyTally ffc 0 2 1 1-	 , testVerifyTally ffc 0 1 2 1-	 , testVerifyTally ffc 0 2 2 1-	 , testVerifyTally ffc 0 5 10 5+testsVerifyTally ::+ ReifyCrypto crypto =>+ Reifies v Version => Proxy v ->+ crypto -> TestTree+testsVerifyTally v crypto =+	testGroup (Text.unpack $ cryptoName crypto)+	 [ testVerifyTally v crypto 0 1 1 1+	 , testVerifyTally v crypto 0 2 1 1+	 , testVerifyTally v crypto 0 1 2 1+	 , testVerifyTally v crypto 0 2 2 1+	 , testVerifyTally v crypto 0 5 10 5 	 ] -testVerifyTally :: FFC -> Int -> Natural -> Natural -> Natural -> TestTree-testVerifyTally ffc seed nTrustees nQuests nChoices =+testVerifyTally ::+ ReifyCrypto crypto =>+ Reifies v Version => Proxy v ->+ crypto -> Int -> Natural -> Natural -> Natural -> TestTree+testVerifyTally (_v::Proxy v) crypto seed nTrustees nQuests nChoices = 	let clearTallyResult = dummyTallyResult nQuests nChoices in 	let decryptedTallyResult :: Either ErrorTally [[Natural]] =-		reify ffc $ \(Proxy::Proxy c) ->+		reifyCrypto crypto $ \(Proxy::Proxy c) -> 		runExcept $ 		(`evalStateT` Random.mkStdGen seed) $ do-			secKeyByTrustee :: [SecretKey c] <-+			secKeyByTrustee :: [SecretKey crypto c] <- 				replicateM (fromIntegral nTrustees) $ randomSecretKey-			trusteePubKeys <- forM secKeyByTrustee $ proveIndispensableTrusteePublicKey+			trusteePubKeys+			 :: [TrusteePublicKey crypto v c]+			 <- forM secKeyByTrustee $ proveIndispensableTrusteePublicKey 			let pubKeyByTrustee = trustee_PublicKey <$> trusteePubKeys 			let elecPubKey = combineIndispensableTrusteePublicKeys trusteePubKeys 			(encTally, countMax) <- encryptTallyResult elecPubKey clearTallyResult-			decShareByTrustee <- forM secKeyByTrustee $ proveDecryptionShare encTally+			decShareByTrustee+			 :: [DecryptionShare crypto v c]+			 <- forM secKeyByTrustee $ proveDecryptionShare encTally 			lift $ verifyDecryptionShareByTrustee encTally pubKeyByTrustee decShareByTrustee 			tally@Tally{..} <- lift $ 				proveTally (encTally, countMax) decShareByTrustee $@@ -90,9 +106,12 @@ 	]  encryptTallyResult ::- Reifies c FFC =>+ Reifies v Version =>+ Reifies c crypto =>+ Group crypto =>+ Multiplicative (FieldElement crypto c) =>  Monad m => RandomGen r =>- PublicKey c -> [[Natural]] -> StateT r m (EncryptedTally c, Natural)+ PublicKey crypto c -> [[Natural]] -> StateT r m (EncryptedTally crypto v c, Natural) encryptTallyResult pubKey countByChoiceByQuest = 	(`runStateT` 0) $ 		forM countByChoiceByQuest $

@@ -1,15 +1,17 @@ module Main where -import System.IO (IO) import Data.Function (($))-import Test.Tasty-import QuickCheck import HUnit+import QuickCheck+import System.IO (IO)+import Test.Tasty+import Voting.Protocol  main :: IO () main = 	defaultMain $-	testGroup "Protocol"-	 [ hunits-	 , quickchecks+	reify stableVersion $ \v ->+	testGroup "Voting.Protocol"+	 [ hunits v+	 , quickchecks v 	 ]

@@ -1,11 +1,12 @@ module QuickCheck where import Test.Tasty+import Voting.Protocol import qualified QuickCheck.Election import qualified QuickCheck.Trustee -quickchecks :: TestTree-quickchecks =+quickchecks :: Reifies v Version => Proxy v -> TestTree+quickchecks v = 	testGroup "QuickCheck"-	 [ QuickCheck.Election.quickcheck-	 , QuickCheck.Trustee.quickcheck+	 [ QuickCheck.Election.quickcheck v+	 , QuickCheck.Trustee.quickcheck v 	 ]

@@ -10,6 +10,7 @@ import GHC.Natural (minusNaturalMaybe) import Prelude (undefined) import Test.Tasty.QuickCheck+import qualified Data.Aeson as JSON import qualified Data.List as List import qualified Data.Text as Text @@ -23,20 +24,23 @@ maxArbitraryQuestions :: Natural maxArbitraryQuestions = 2 -quickcheck :: TestTree-quickcheck =+quickcheck :: Reifies v Version => Proxy v -> TestTree+quickcheck v = 	testGroup "Election" 	 [ testGroup "verifyBallot" $-		 [ testElection weakFFC-		 , testElection beleniosFFC+		 [ quickcheckElection v weakFFC+		 , quickcheckElection v beleniosFFC 		 ] 	 ] -testElection :: FFC -> TestTree-testElection ffc =-	reify ffc $ \(Proxy::Proxy c) ->-	testGroup (Text.unpack $ ffc_name ffc)-	 [ testProperty "verifyBallot" $ \(seed, (elec::Election c) :> votes) ->+quickcheckElection ::+ ReifyCrypto crypto =>+ Reifies v Version => Proxy v ->+ crypto -> TestTree+quickcheckElection (_v::Proxy v) crypto =+	reifyCrypto crypto $ \(Proxy::Proxy c) ->+	testGroup (Text.unpack $ cryptoName crypto)+	 [ testProperty "verifyBallot" $ \(seed, (elec::Election crypto v c) :> votes) -> 		isRight $ runExcept $ 			(`evalStateT` mkStdGen seed) $ do 				-- ballotSecKey :: SecretKey c <- randomSecretKey@@ -47,23 +51,34 @@  instance Reifies c FFC => Arbitrary (F c) where 	arbitrary = F <$> choose (zero, fromJust $ fieldCharac @c `minusNaturalMaybe` one)-instance Reifies c FFC => Arbitrary (G c) where+instance+ ( Reifies c crypto+ , Group crypto+ , Multiplicative (FieldElement crypto c)+ ) => Arbitrary (G crypto c) where 	arbitrary = do 		m <- arbitrary 		return (groupGen ^ m)-instance Reifies c FFC => Arbitrary (E c) where-	arbitrary = E <$> choose (zero, fromJust $ groupOrder @c `minusNaturalMaybe` one)+instance+ ( Reifies c crypto+ , Group crypto+ ) => Arbitrary (E crypto c) where+	arbitrary = E <$> choose (zero, fromJust $ groupOrder @crypto (Proxy @c) `minusNaturalMaybe` one) instance Arbitrary UUID where 	arbitrary = do 		seed <- arbitrary 		(`evalStateT` mkStdGen seed) $ 			randomUUID-instance Reifies c FFC => Arbitrary (Proof c) where+instance+ ( Reifies v Version+ , Reifies c crypto+ , Arbitrary (E crypto c)+ ) => Arbitrary (Proof crypto v c) where 	arbitrary = do 		proof_challenge <- arbitrary 		proof_response  <- arbitrary 		return Proof{..}-instance Arbitrary Question where+instance Reifies v Version => Arbitrary (Question v) where 	arbitrary = do 		let question_text = "question" 		choices :: Natural <- choose (1, maxArbitraryChoices)@@ -78,16 +93,26 @@ 		, question_mini <- shrinkIntegral $ min nChoices $ max zero $ question_mini quest 		, question_maxi <- shrinkIntegral $ min nChoices $ max question_mini $ question_maxi quest 		]-instance Reifies c FFC => Arbitrary (Election c) where+instance+ ( Reifies v Version+ , Reifies c crypto+ , Group crypto+ , Key crypto+ , Multiplicative (FieldElement crypto c)+ , JSON.ToJSON crypto+ , JSON.ToJSON (FieldElement crypto c)+ ) => Arbitrary (Election crypto v c) where 	arbitrary = do 		let election_name = "election" 		let election_description = "description"-		election_crypto <- arbitrary+		let election_crypto = reflect (Proxy @c)+		election_secret_key <- arbitrary+		let election_public_key = publicKey election_secret_key 		election_questions <- resize (fromIntegral maxArbitraryQuestions) $ listOf1 arbitrary 		election_uuid <- arbitrary-		let elec =-			Election-			 { election_hash = hashElection elec+		let elec = Election+			 { election_hash    = hashElection elec+			 , election_version = Just (reflect (Proxy @v)) 			 , .. 			 } 		return elec@@ -95,16 +120,18 @@ 		[ elec{election_questions} 		| election_questions <- shrink $ election_questions elec 		]+{- instance Reifies c FFC => Arbitrary (ElectionCrypto c) where 	arbitrary = do 		let electionCrypto_FFC_params = reflect (Proxy::Proxy c) 		electionCrypto_FFC_PublicKey <- arbitrary 		return ElectionCrypto_FFC{..}+-}  -- | A type to declare an 'Arbitrary' instance where @b@ depends on @a@. data (:>) a b = a :> b  deriving (Eq,Show)-instance Arbitrary (Question :> [Bool]) where+instance Reifies v Version => Arbitrary (Question v :> [Bool]) where 	arbitrary = do 		quest@Question{..} <- arbitrary 		votes <- do@@ -117,7 +144,15 @@ 		[ q :> shrinkVotes q votes 		| q <- shrink quest 		]-instance Reifies c FFC => Arbitrary (Election c :> [[Bool]]) where+instance+ ( Reifies v Version+ , Reifies c crypto+ , Group crypto+ , Key crypto+ , JSON.ToJSON crypto+ , JSON.ToJSON (FieldElement crypto c)+ , Multiplicative (FieldElement crypto c)+ ) => Arbitrary (Election crypto v c :> [[Bool]]) where 	arbitrary = do 		elec@Election{..} <- arbitrary 		votes <- forM election_questions $ \Question{..} -> do@@ -127,7 +162,7 @@ 			return $ boolsOfCombin numChoices numTrue rank 		return (elec :> votes) 	shrink (elec :> votes) =-		[ e :> List.zipWith shrinkVotes (election_questions e) votes+		[ e :> List.zipWith shrinkVotes (election_questions e :: [Question v]) votes 		| e <- shrink elec 		] @@ -149,7 +184,7 @@ -- | @('shrinkVotes' quest votes)@ -- returns a reduced version of the given @votes@ -- to fit the requirement of the given @quest@.-shrinkVotes :: Question -> [Bool] -> [Bool]+shrinkVotes :: Reifies v Version => Question v -> [Bool] -> [Bool] shrinkVotes Question{..} votes = 	(\(nTrue, b) -> nTrue <= nat question_maxi && b) 	 <$> List.zip (countTrue votes) votes@@ -159,4 +194,3 @@ 		where 		inc [] = [zero] 		inc (n:ns) = (n+one):n:ns-

@@ -1,4 +1,5 @@ {-# OPTIONS -fno-warn-orphans #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE UndecidableInstances #-} -- for Reifies instances module QuickCheck.Trustee where @@ -10,28 +11,37 @@ import Utils import QuickCheck.Election () -quickcheck :: TestTree-quickcheck =-	testGroup "Trustee"+quickcheck :: Reifies v Version => Proxy v -> TestTree+quickcheck v =+	testGroup "Trustee" $ 	 [ testGroup "verifyIndispensableTrusteePublicKey" $-		 [ testIndispensableTrusteePublicKey weakFFC-		 , testIndispensableTrusteePublicKey beleniosFFC+		 [ testIndispensableTrusteePublicKey v weakFFC+		 , testIndispensableTrusteePublicKey v beleniosFFC 		 ] 	 ] -testIndispensableTrusteePublicKey :: FFC -> TestTree-testIndispensableTrusteePublicKey ffc =-	reify ffc $ \(Proxy::Proxy c) ->-	testGroup (Text.unpack $ ffc_name ffc)+testIndispensableTrusteePublicKey ::+ ReifyCrypto crypto =>+ Reifies v Version => Proxy v ->+ crypto -> TestTree+testIndispensableTrusteePublicKey (_v::Proxy v) crypto =+	reifyCrypto crypto $ \(Proxy::Proxy c) ->+	testGroup (Text.unpack $ cryptoName crypto) 	 [ testProperty "Right" $ \seed -> 		isRight $ runExcept $ 			(`evalStateT` mkStdGen seed) $ do-				trusteeSecKey :: SecretKey c <- randomSecretKey-				trusteePubKey <- proveIndispensableTrusteePublicKey trusteeSecKey+				trusteeSecKey :: SecretKey crypto c <- randomSecretKey+				trusteePubKey :: TrusteePublicKey crypto v c+				 <- proveIndispensableTrusteePublicKey trusteeSecKey 				lift $ verifyIndispensableTrusteePublicKey trusteePubKey 	 ] -instance Reifies c FFC => Arbitrary (TrusteePublicKey c) where+instance+ ( Reifies v Version+ , Reifies c crypto+ , Group crypto+ , Multiplicative (FieldElement crypto c)+ ) => Arbitrary (TrusteePublicKey crypto v c) where 	arbitrary = do 		trustee_PublicKey <- arbitrary 		trustee_SecretKeyProof <- arbitrary