packages feed

hjugement-protocol 0.0.4.20190711 → 0.0.7.20190815

raw patch · 8 files changed

+250/−101 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Voting.Protocol.Election: Hash :: Text -> Hash
- Voting.Protocol.Election: hashJSON :: ToJSON a => a -> Hash
- Voting.Protocol.Election: instance Control.DeepSeq.NFData Voting.Protocol.Election.Hash
- Voting.Protocol.Election: instance Data.Aeson.Types.FromJSON.FromJSON (Voting.Protocol.Election.Election c)
- Voting.Protocol.Election: instance Data.Aeson.Types.FromJSON.FromJSON (Voting.Protocol.Election.ElectionCrypto c)
- Voting.Protocol.Election: instance Data.Aeson.Types.FromJSON.FromJSON Voting.Protocol.Election.Hash
- Voting.Protocol.Election: instance Data.Aeson.Types.ToJSON.ToJSON Voting.Protocol.Election.Hash
- Voting.Protocol.Election: instance GHC.Classes.Eq Voting.Protocol.Election.Hash
- Voting.Protocol.Election: instance GHC.Classes.Ord Voting.Protocol.Election.Hash
- Voting.Protocol.Election: instance GHC.Generics.Generic Voting.Protocol.Election.Hash
- Voting.Protocol.Election: instance GHC.Show.Show Voting.Protocol.Election.Hash
- Voting.Protocol.Election: newtype Hash
- Voting.Protocol.FFC: hexHash :: ByteString -> Text
+ Voting.Protocol.Election: commitQuicker :: Reifies c FFC => Proof c -> G c -> G c -> Commitment c
+ Voting.Protocol.Election: instance Data.Aeson.Types.FromJSON.FromJSON (Voting.Protocol.Election.Election ())
+ Voting.Protocol.Election: instance Data.Aeson.Types.FromJSON.FromJSON (Voting.Protocol.Election.ElectionCrypto ())
+ Voting.Protocol.Election: proveQuicker :: Reifies c FFC => Monad m => RandomGen r => Functor list => E c -> list (G c) -> Oracle list c -> StateT r m (Proof c)
+ Voting.Protocol.Election: readElection :: FilePath -> ExceptT String IO (Election ())
+ Voting.Protocol.FFC: Base64SHA256 :: Text -> Base64SHA256
+ Voting.Protocol.FFC: Hash :: E c -> Hash c
+ Voting.Protocol.FFC: HexSHA256 :: Text -> HexSHA256
+ Voting.Protocol.FFC: base64SHA256 :: ByteString -> Base64SHA256
+ Voting.Protocol.FFC: hexSHA256 :: ByteString -> Text
+ Voting.Protocol.FFC: instance Control.DeepSeq.NFData (Voting.Protocol.FFC.Hash c)
+ Voting.Protocol.FFC: instance Control.DeepSeq.NFData Voting.Protocol.FFC.Base64SHA256
+ Voting.Protocol.FFC: instance Control.DeepSeq.NFData Voting.Protocol.FFC.HexSHA256
+ Voting.Protocol.FFC: instance Data.Aeson.Types.FromJSON.FromJSON Voting.Protocol.FFC.Base64SHA256
+ Voting.Protocol.FFC: instance Data.Aeson.Types.FromJSON.FromJSON Voting.Protocol.FFC.HexSHA256
+ Voting.Protocol.FFC: instance Data.Aeson.Types.ToJSON.ToJSON Voting.Protocol.FFC.Base64SHA256
+ Voting.Protocol.FFC: instance Data.Aeson.Types.ToJSON.ToJSON Voting.Protocol.FFC.HexSHA256
+ Voting.Protocol.FFC: instance GHC.Classes.Eq (Voting.Protocol.FFC.Hash c)
+ Voting.Protocol.FFC: instance GHC.Classes.Eq Voting.Protocol.FFC.Base64SHA256
+ Voting.Protocol.FFC: instance GHC.Classes.Eq Voting.Protocol.FFC.HexSHA256
+ Voting.Protocol.FFC: instance GHC.Classes.Ord (Voting.Protocol.FFC.Hash c)
+ Voting.Protocol.FFC: instance GHC.Classes.Ord Voting.Protocol.FFC.Base64SHA256
+ Voting.Protocol.FFC: instance GHC.Classes.Ord Voting.Protocol.FFC.HexSHA256
+ Voting.Protocol.FFC: instance GHC.Generics.Generic Voting.Protocol.FFC.Base64SHA256
+ Voting.Protocol.FFC: instance GHC.Generics.Generic Voting.Protocol.FFC.HexSHA256
+ Voting.Protocol.FFC: instance GHC.Show.Show (Voting.Protocol.FFC.Hash c)
+ Voting.Protocol.FFC: instance GHC.Show.Show Voting.Protocol.FFC.Base64SHA256
+ Voting.Protocol.FFC: instance GHC.Show.Show Voting.Protocol.FFC.HexSHA256
+ Voting.Protocol.FFC: newtype Base64SHA256
+ Voting.Protocol.FFC: newtype Hash c
+ Voting.Protocol.FFC: newtype HexSHA256
- Voting.Protocol.Election: Ballot :: ![Answer c] -> !Maybe (Signature c) -> !UUID -> !Hash -> Ballot c
+ Voting.Protocol.Election: Ballot :: ![Answer c] -> !Maybe (Signature c) -> !UUID -> !Base64SHA256 -> Ballot c
- Voting.Protocol.Election: Election :: !Text -> !Text -> !ElectionCrypto c -> ![Question] -> !UUID -> !Hash -> Election c
+ Voting.Protocol.Election: Election :: !Text -> !Text -> !ElectionCrypto c -> ![Question] -> !UUID -> Base64SHA256 -> Election c
- Voting.Protocol.Election: [ballot_election_hash] :: Ballot c -> !Hash
+ Voting.Protocol.Election: [ballot_election_hash] :: Ballot c -> !Base64SHA256
- Voting.Protocol.Election: [election_hash] :: Election c -> !Hash
+ Voting.Protocol.Election: [election_hash] :: Election c -> Base64SHA256
- Voting.Protocol.Election: hashElection :: Election c -> Election c
+ Voting.Protocol.Election: hashElection :: Election c -> Base64SHA256

Files

benchmarks/Election.hs view
@@ -9,22 +9,25 @@ import Utils  makeElection :: forall c. Reifies c FFC => Int -> Int -> Election c-makeElection nQuests nChoices = hashElection $ Election- { election_name = Text.pack $ "elec"<>show nQuests<>show nChoices- , election_description = "benchmarkable election"- , election_uuid- , election_crypto = ElectionCrypto_FFC (reflect (Proxy::Proxy c)) $-	let secKey = credentialSecretKey election_uuid (Credential "xLcs7ev6Jy6FHHE") in-	publicKey secKey- , election_hash = Hash ""- , election_questions =-	(<$> [1..nQuests]) $ \quest -> Question-	 { question_text = Text.pack $ "quest"<>show quest-	 , question_choices = (<$> [1..nChoices]) $ \choice -> Text.pack $ "choice"<>show choice-	 , question_mini = one-	 , question_maxi = one -- sum $ List.replicate nChoices one+makeElection nQuests nChoices = elec+	where+	election_uuid = UUID "xLcs7ev6Jy6FHH"+	elec = Election+	 { election_name = Text.pack $ "elec"<>show nQuests<>show nChoices+	 , election_description = "benchmarkable election"+	 , election_uuid+	 , election_crypto = ElectionCrypto_FFC (reflect (Proxy::Proxy c)) $+		let secKey = credentialSecretKey election_uuid (Credential "xLcs7ev6Jy6FHHE") in+		publicKey secKey+	 , election_hash = hashElection elec+	 , election_questions =+		(<$> [1..nQuests]) $ \quest -> Question+		 { question_text = Text.pack $ "quest"<>show quest+		 , question_choices = (<$> [1..nChoices]) $ \choice -> Text.pack $ "choice"<>show choice+		 , question_mini = one+		 , question_maxi = one -- sum $ List.replicate nChoices one+		 } 	 }- } where election_uuid = UUID "xLcs7ev6Jy6FHH"  makeVotes :: Election c -> [[Bool]] makeVotes Election{..} =
hjugement-protocol.cabal view
@@ -2,7 +2,7 @@ -- PVP:  +-+------- breaking API changes --       | | +----- non-breaking API additions --       | | | +--- code changes with no API change-version: 0.0.4.20190711+version: 0.0.7.20190815 category: Politic synopsis: A cryptographic protocol for the Majority Judgment. description:
src/Voting/Protocol/Election.hs view
@@ -10,7 +10,7 @@ import Control.DeepSeq (NFData) import Control.Monad (Monad(..), join, mapM, replicateM, zipWithM) import Control.Monad.Trans.Class (MonadTrans(..))-import Control.Monad.Trans.Except (ExceptT, runExcept, throwE, withExceptT)+import Control.Monad.Trans.Except (ExceptT(..), runExcept, throwE, withExceptT) import Data.Aeson (ToJSON(..),FromJSON(..),(.:),(.:?),(.=)) import Data.Bool import Data.Either (either)@@ -19,9 +19,11 @@ import Data.Function (($), (.), id, const) import Data.Functor (Functor, (<$>)) import Data.Functor.Identity (Identity(..))-import Data.Maybe (Maybe(..), fromJust)+import Data.Maybe (Maybe(..), maybe, fromJust)+import Data.Monoid (Monoid(..)) import Data.Ord (Ord(..)) import Data.Semigroup (Semigroup(..))+import Data.String (String) import Data.Text (Text) import Data.Traversable (Traversable(..)) import Data.Tuple (fst, snd)@@ -29,14 +31,13 @@ import GHC.Natural (minusNaturalMaybe) import Numeric.Natural (Natural) import Prelude (fromIntegral)+import System.IO (IO, FilePath) import Text.Show (Show(..)) import qualified Control.Monad.Trans.State.Strict as S import qualified Data.Aeson as JSON import qualified Data.ByteString as BS-import qualified Data.ByteString.Base64.Lazy as BSL64+import qualified Data.ByteString.Lazy as BSL import qualified Data.List as List-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Encoding as TL  import Voting.Protocol.Utils import Voting.Protocol.FFC@@ -62,7 +63,17 @@    -- ^ Encrypted 'clear' text,    -- equal to @('pubKey' '^'encNone '*' 'groupGen' '^'clear)@  } deriving (Eq,Show,Generic,NFData)-deriving instance Reifies c FFC => ToJSON (Encryption c)+instance Reifies c FFC => ToJSON (Encryption c) where+	toJSON Encryption{..} =+		JSON.object+		 [ "alpha" .= encryption_nonce+		 , "beta"  .= encryption_vault+		 ]+	toEncoding Encryption{..} =+		JSON.pairs+		 (  "alpha" .= encryption_nonce+		 <> "beta"  .= encryption_vault+		 ) instance Reifies c FFC => FromJSON (Encryption c) where 	parseJSON = JSON.withObject "Encryption" $ \o -> do 		encryption_nonce <- o .: "alpha"@@ -209,6 +220,22 @@ 	let proof_challenge = oracle commitments 	return Proof 	 { proof_challenge+	 , proof_response = nonce + sec*proof_challenge+	   -- TODO: switch (+) to (-) when 'commit' will switch (/) to (*).+	 }++-- | Like 'prove' but quicker. It chould replace 'prove' entirely+-- when Helios-C specifications will be fixed.+proveQuicker ::+ Reifies c FFC =>+ Monad m => RandomGen r => Functor list =>+ E c -> list (G c) -> Oracle list c -> S.StateT r m (Proof c)+proveQuicker 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 	 } @@ -239,14 +266,21 @@ -- from the given 'Proof' with the knowledge of the verifier. commit :: Reifies c FFC => Proof c -> G c -> G c -> Commitment c commit Proof{..} base basePowSec =-	base^proof_response *+	base^proof_response / 	basePowSec^proof_challenge-  -- NOTE: Contrary to some textbook presentations,-  -- @('*')@ is used instead of @('/')@ to avoid the performance cost+  -- TODO: contrary to some textbook presentations,+  -- @('*')@ should be used instead of @('/')@ to avoid the performance cost   -- of a modular exponentiation @('^' ('groupOrder' '-' 'one'))@,-  -- this is compensated by using @('-')@ instead of @('+')@ in 'prove'.+  -- this would be 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 Proof{..} base basePowSec =+	base^proof_response *+	basePowSec^proof_challenge+ -- * Type 'Disjunction' -- | A 'Disjunction' is an 'inv'ersed @('groupGen' '^'opinion)@ -- it's used in 'proveEncryption' to generate a 'Proof'@@ -374,7 +408,29 @@  , question_mini    :: !Natural  , question_maxi    :: !Natural  -- , question_blank :: Maybe Bool- } deriving (Eq,Show,Generic,NFData,ToJSON,FromJSON)+ } deriving (Eq,Show,Generic,NFData)+instance ToJSON Question where+	toJSON Question{..} =+		JSON.object+		 [ "question" .= question_text+		 , "answers"  .= question_choices+		 , "min"      .= question_mini+		 , "max"      .= question_maxi+		 ]+	toEncoding Question{..} =+		JSON.pairs+		 (  "question" .= question_text+		 <> "answers"  .= question_choices+		 <> "min"      .= question_mini+		 <> "max"      .= question_maxi+		 )+instance FromJSON Question where+	parseJSON = JSON.withObject "Question" $ \o -> do+		question_text    <- o .: "question"+		question_choices <- o .: "answers"+		question_mini    <- o .: "min"+		question_maxi    <- o .: "max"+		return Question{..}  -- * Type 'Answer' data Answer c = Answer@@ -386,7 +442,23 @@    -- is an element of @[mini..maxi]@.  -- , answer_blankProof ::  } deriving (Eq,Show,Generic,NFData)-deriving instance Reifies c FFC => ToJSON (Answer c)+instance Reifies c FFC => ToJSON (Answer c) where+	toJSON Answer{..} =+		let (answer_choices, answer_individual_proofs) =+			List.unzip answer_opinions in+		JSON.object+		 [ "choices"           .= answer_choices+		 , "individual_proofs" .= answer_individual_proofs+		 , "overall_proof"     .= answer_sumProof+		 ]+	toEncoding Answer{..} =+		let (answer_choices, answer_individual_proofs) =+			List.unzip answer_opinions in+		JSON.pairs+		 (  "choices"           .= answer_choices+		 <> "individual_proofs" .= answer_individual_proofs+		 <> "overall_proof"     .= answer_sumProof+		 ) instance Reifies c FFC => FromJSON (Answer c) where 	parseJSON = JSON.withObject "Answer" $ \o -> do 		answer_choices <- o .: "choices"@@ -472,7 +544,7 @@  , election_crypto      :: !(ElectionCrypto c)  , election_questions   :: ![Question]  , election_uuid        :: !UUID- , election_hash        :: !Hash+ , election_hash        :: Base64SHA256  } deriving (Eq,Show,Generic,NFData)  instance ToJSON (Election c) where@@ -492,15 +564,26 @@ 		 <> "questions"   .= election_questions 		 <> "uuid"        .= election_uuid 		 )-instance FromJSON (Election c) where+instance FromJSON (Election ()) where 	parseJSON = JSON.withObject "Election" $ \o -> Election 	 <$> o .: "name" 	 <*> o .: "description" 	 <*> o .: "public_key" 	 <*> o .: "questions" 	 <*> o .: "uuid"-	 <*> pure (hashJSON (JSON.Object o))+	 <*> pure (Base64SHA256 "")+	     -- NOTE: set in 'readElection'. +readElection :: FilePath -> ExceptT String IO (Election ())+readElection filePath = do+	fileData <- lift $ BS.readFile filePath+	ExceptT $ return $+		(\e -> e{election_hash=base64SHA256 fileData})+		 <$> JSON.eitherDecodeStrict' fileData++hashElection :: Election c -> Base64SHA256+hashElection = base64SHA256 . BSL.toStrict . JSON.encode+ -- ** Type 'ElectionCrypto' data ElectionCrypto c =  ElectionCrypto_FFC@@ -519,44 +602,41 @@ 	toJSON (ElectionCrypto_FFC ffc pubKey) = 		JSON.object 		 [ "group" .= ffc-		 , "y"     .= nat pubKey+		 , "y"     .= pubKey 		 ] 	toEncoding (ElectionCrypto_FFC ffc pubKey) = 		JSON.pairs 		 (  "group" .= ffc-		 <> "y"     .= nat pubKey+		 <> "y"     .= pubKey 		 )-instance FromJSON (ElectionCrypto c) where+instance FromJSON (ElectionCrypto ()) where 	parseJSON = JSON.withObject "ElectionCrypto" $ \o -> do 		ffc <- o .: "group" 		pubKey <- reify ffc $ \(_::Proxy s) -> nat <$> ((.:) @(PublicKey s) o "y")-		{--		unless (nat ffc_groupGen < ffc_fieldCharac) $-			JSON.typeMismatch "FFC: groupGen is not lower than fieldCharac" (JSON.Object o)-		-} 		return $ ElectionCrypto_FFC ffc (G (F pubKey)) ---- ** Type 'Hash'-newtype Hash = Hash Text- deriving (Eq,Ord,Show,Generic)- deriving anyclass (ToJSON,FromJSON)- deriving newtype NFData--hashJSON :: ToJSON a => a -> Hash-hashJSON = Hash . TL.toStrict . TL.decodeUtf8 . BSL64.encode . JSON.encode--hashElection :: Election c -> Election c-hashElection elec = elec{election_hash=hashJSON elec}- -- * Type 'Ballot' data Ballot c = Ballot  { ballot_answers       :: ![Answer c]  , ballot_signature     :: !(Maybe (Signature c))  , ballot_election_uuid :: !UUID- , ballot_election_hash :: !Hash+ , ballot_election_hash :: !Base64SHA256  } deriving (Generic,NFData)-deriving instance Reifies c FFC => ToJSON (Ballot c)+instance Reifies c FFC => ToJSON (Ballot c) where+	toJSON Ballot{..} =+		JSON.object $+		 [ "answers"       .= ballot_answers+		 , "election_uuid" .= ballot_election_uuid+		 , "election_hash" .= ballot_election_hash+		 ] <>+		 maybe [] (\sig -> [ "signature" .= sig ]) ballot_signature+	toEncoding Ballot{..} =+		JSON.pairs $+		 (  "answers"       .= ballot_answers+		 <> "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 	parseJSON = JSON.withObject "Ballot" $ \o -> do 		ballot_answers       <- o .: "answers"@@ -597,7 +677,7 @@ 	 Nothing -> return Nothing 	 Just (ballotSecKey, signature_publicKey) -> do 		signature_proof <--			prove ballotSecKey (Identity groupGen) $+			proveQuicker ballotSecKey (Identity groupGen) $ 			 \(Identity commitment) -> 				hash 				 -- NOTE: the order is unusual, the commitments are first@@ -626,7 +706,7 @@ 			let zkp = ZKP (bytesNat signature_publicKey) in 			(, zkp) $ 				proof_challenge signature_proof == hash-				 (signatureCommitments zkp (commit signature_proof groupGen signature_publicKey))+				 (signatureCommitments zkp (commitQuicker signature_proof groupGen signature_publicKey)) 				 (signatureStatement ballot_answers) 	in 	and $ isValidSign :@@ -644,7 +724,19 @@    -- ^ Verification key.  , signature_proof     :: !(Proof c)  } deriving (Generic,NFData)-deriving instance Reifies c FFC => ToJSON (Signature c)+instance Reifies c FFC => ToJSON (Signature c) where+	toJSON (Signature pubKey Proof{..}) =+		JSON.object+		 [ "public_key" .= pubKey+		 , "challenge"  .= proof_challenge+		 , "response"   .= proof_response+		 ]+	toEncoding (Signature pubKey Proof{..}) =+		JSON.pairs+		 (  "public_key" .= pubKey+		 <> "challenge"  .= proof_challenge+		 <> "response"   .= proof_response+		 ) instance Reifies c FFC => FromJSON (Signature c) where 	parseJSON = JSON.withObject "Signature" $ \o -> do 		signature_publicKey <- o .: "public_key"
src/Voting/Protocol/FFC.hs view
@@ -28,6 +28,7 @@ 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)@@ -46,9 +47,11 @@ 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@@ -89,19 +92,18 @@  } deriving (Eq,Show,Generic,NFData) instance ToJSON FFC where 	toJSON FFC{..} =-		JSON.object-		 [ "name" .= ffc_name-		 , "p"    .= show ffc_fieldCharac-		 , "g"    .= show ffc_groupGen-		 , "q"    .= show ffc_groupOrder+		JSON.object $+		 (if Text.null ffc_name then [] else ["name" .= ffc_name] ) <>+		 [ "p" .= show ffc_fieldCharac+		 , "g" .= show ffc_groupGen+		 , "q" .= show ffc_groupOrder 		 ] 	toEncoding FFC{..} =-		JSON.pairs-		 (  "name" .= ffc_name-		 <> "p"    .= show ffc_fieldCharac-		 <> "g"    .= show ffc_groupGen-		 <> "q"    .= show ffc_groupOrder-		 )+		JSON.pairs $+			(if Text.null ffc_name then mempty else "name" .= ffc_name) <>+			"p" .= show ffc_fieldCharac <>+			"g" .= show ffc_groupGen <>+			"q" .= show ffc_groupOrder instance FromJSON FFC where 	parseJSON = JSON.withObject "FFC" $ \o -> do 		ffc_name <- fromMaybe "" <$> (o .:? "name")@@ -160,14 +162,6 @@  , ffc_groupOrder  = 78571733251071885079927659812671450121821421258408794611510081919805623223441  } -{--data WithFFC t = forall c. Reifies c FFC => WithFFC (t c)--reifyFFC :: WithFFC t -> (forall c. Reifies c FFC => t c -> k) -> k-Coercible-reifyFFC (WithFFC ffc t) k = reify ffc $ \(_::Proxy c) -> k @c--}- -- * Type 'F' -- | The type of the elements of a Finite Prime Field. --@@ -324,6 +318,11 @@ 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',@@ -342,14 +341,43 @@ 	fromNatural $ 		decodeBigEndian $ ByteArray.convert h --- | @('hexHash' bs)@ returns the 'Crypto.SHA256' hash+-- | @('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.-hexHash :: BS.ByteString -> Text-hexHash bs =+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@@ -358,13 +386,6 @@ 	TL.toStrict $ 	TL.tail $ TLB.toLazyText $ TLB.hexadecimal $ 	setBit n 256---- | @('decodeBigEndian' bs)@ interpret @bs@ as big-endian number.-decodeBigEndian :: BS.ByteString -> Natural-decodeBigEndian =-	BS.foldl'-	 (\acc b -> acc`shiftL`8 + fromIntegral b)-	 (0::Natural)  -- * Type 'E' -- | An exponent of a (necessarily cyclic) subgroup of a Finite Prime Field.
src/Voting/Protocol/Tally.hs view
@@ -47,8 +47,28 @@  , tally_countByChoiceByQuest :: ![[Natural]]    -- ^ The decrypted count of supportive 'Opinion's, by choice by 'Question'.  } deriving (Eq,Show,Generic,NFData)-deriving instance Reifies c FFC => ToJSON (Tally c)-deriving instance Reifies c FFC => FromJSON (Tally c)+instance Reifies c FFC => ToJSON (Tally c) where+	toJSON Tally{..} =+		JSON.object+		 [ "num_tallied"         .= tally_countMax+		 , "encrypted_tally"     .= tally_encByChoiceByQuest+		 , "partial_decryptions" .= tally_decShareByTrustee+		 , "result"              .= tally_countByChoiceByQuest+		 ]+	toEncoding Tally{..} =+		JSON.pairs+		 (  "num_tallied"         .= tally_countMax+		 <> "encrypted_tally"     .= tally_encByChoiceByQuest+		 <> "partial_decryptions" .= tally_decShareByTrustee+		 <> "result"              .= tally_countByChoiceByQuest+		 )+instance Reifies c FFC => FromJSON (Tally c) where+	parseJSON = JSON.withObject "Tally" $ \o -> do+		tally_countMax             <- o .: "num_tallied"+		tally_encByChoiceByQuest   <- o .: "encrypted_tally"+		tally_decShareByTrustee    <- o .: "partial_decryptions"+		tally_countByChoiceByQuest <- o .: "result"+		return Tally{..}  -- ** Type 'EncryptedTally' -- | 'Encryption' by choice by 'Question'.
src/Voting/Protocol/Trustee/Indispensable.hs view
@@ -62,11 +62,7 @@ 		trustee_SecretKeyProof <- o .: "pok" 		return TrusteePublicKey{..} --- ** Type 'ErrorTrusteePublicKey'-data ErrorTrusteePublicKey- =   ErrorTrusteePublicKey_WrongProof-     -- ^ The 'trustee_SecretKeyProof' is wrong.- deriving (Eq,Show)+-- ** Generating a 'TrusteePublicKey'  -- | @('proveIndispensableTrusteePublicKey' trustSecKey)@ -- returns the 'PublicKey' associated to 'trustSecKey'@@ -81,6 +77,8 @@ 			hash (indispensableTrusteePublicKeyStatement trustee_PublicKey) 	return TrusteePublicKey{..} +-- ** Checking a 'TrusteePublicKey' before incorporating it into the 'Election''s 'PublicKey'+ -- | @('verifyIndispensableTrusteePublicKey' trustPubKey)@ -- returns 'True' iif. the given 'trustee_SecretKeyProof' -- does 'prove' that the 'SecretKey' associated with@@ -90,12 +88,19 @@  TrusteePublicKey c ->  ExceptT ErrorTrusteePublicKey m () verifyIndispensableTrusteePublicKey TrusteePublicKey{..} =-	unless ((proof_challenge trustee_SecretKeyProof ==) $-	hash-	 (indispensableTrusteePublicKeyStatement trustee_PublicKey)-	 [commit trustee_SecretKeyProof groupGen trustee_PublicKey]) $+	unless (+		proof_challenge trustee_SecretKeyProof == hash+		 (indispensableTrusteePublicKeyStatement trustee_PublicKey)+		 [commit trustee_SecretKeyProof groupGen trustee_PublicKey]+	 ) $ 		throwE ErrorTrusteePublicKey_WrongProof +-- ** Type 'ErrorTrusteePublicKey'+data ErrorTrusteePublicKey+ =   ErrorTrusteePublicKey_WrongProof+     -- ^ The 'trustee_SecretKeyProof' is wrong.+ deriving (Eq,Show)+ -- ** Hashing indispensableTrusteePublicKeyStatement :: PublicKey c -> BS.ByteString indispensableTrusteePublicKeyStatement trustPubKey =@@ -103,11 +108,15 @@  -- * 'Election''s 'PublicKey' +-- ** Generating an 'Election''s 'PublicKey' from multiple 'TrusteePublicKey's.+ combineIndispensableTrusteePublicKeys ::  Reifies c FFC => [TrusteePublicKey c] -> PublicKey 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] ->@@ -115,6 +124,8 @@ verifyIndispensableDecryptionShareByTrustee encByChoiceByQuest = 	isoZipWithM_ (throwE $ ErrorTally_NumberOfTrustees) 	 (verifyDecryptionShare encByChoiceByQuest)++-- ** Decrypting an 'EncryptedTally' from multiple 'TrusteePublicKey's.  -- | @('combineDecryptionShares' pubKeyByTrustee decShareByTrustee)@ -- returns the 'DecryptionFactor's by choice by 'Question'
tests/HUnit/Election.hs view
@@ -4,7 +4,6 @@ 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@@ -94,7 +93,7 @@ 				 , election_crypto      = ElectionCrypto_FFC ffc elecPubKey 				 , election_questions   = quests 				 , election_uuid        = uuid-				 , election_hash        = hashJSON JSON.Null+				 , election_hash        = hashElection elec 				 } 			verifyBallot elec 			 <$> encryptBallot elec (Just ballotSecKey) opins
tests/QuickCheck/Election.hs view
@@ -10,7 +10,6 @@ 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 @@ -86,8 +85,12 @@ 		election_crypto <- arbitrary 		election_questions <- resize (fromIntegral maxArbitraryQuestions) $ listOf1 arbitrary 		election_uuid <- arbitrary-		let election_hash = hashJSON JSON.Null-		return Election{..}+		let elec =+			Election+			 { election_hash = hashElection elec+			 , ..+			 }+		return elec 	shrink elec = 		[ elec{election_questions} 		| election_questions <- shrink $ election_questions elec