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 +18/−15
- hjugement-protocol.cabal +1/−1
- src/Voting/Protocol/Election.hs +132/−40
- src/Voting/Protocol/FFC.hs +50/−29
- src/Voting/Protocol/Tally.hs +22/−2
- src/Voting/Protocol/Trustee/Indispensable.hs +20/−9
- tests/HUnit/Election.hs +1/−2
- tests/QuickCheck/Election.hs +6/−3
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