-- PVP: +-+------- breaking API changes
-- | | +----- non-breaking API additions
-- | | | +--- code changes with no API change
-version: 0.0.3.20190701
+version: 0.0.4.20190711
category: Politic
synopsis: A cryptographic protocol for the Majority Judgment.
description:
import Control.Monad (Monad(..), join, mapM, replicateM, zipWithM)
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Trans.Except (ExceptT, runExcept, throwE, withExceptT)
-import Data.Aeson (ToJSON(..),FromJSON(..),(.:),(.=))
+import Data.Aeson (ToJSON(..),FromJSON(..),(.:),(.:?),(.=))
import Data.Bool
import Data.Either (either)
import Data.Eq (Eq(..))
-- equal to @('pubKey' '^'encNone '*' 'groupGen' '^'clear)@
} deriving (Eq,Show,Generic,NFData)
deriving instance Reifies c FFC => ToJSON (Encryption c)
-deriving instance Reifies c FFC => FromJSON (Encryption c)
+instance Reifies c FFC => FromJSON (Encryption c) where
+ parseJSON = JSON.withObject "Encryption" $ \o -> do
+ encryption_nonce <- o .: "alpha"
+ encryption_vault <- o .: "beta"
+ return Encryption{..}
-- | Additive homomorphism.
-- Using the fact that: @'groupGen' '^'x '*' 'groupGen' '^'y '==' 'groupGen' '^'(x'+'y)@.
-- to ensure that each 'prove' does not reveal any information
-- about its secret.
} deriving (Eq,Show,Generic,NFData)
-deriving instance Reifies c FFC => ToJSON (Proof c)
-deriving instance Reifies c FFC => FromJSON (Proof c)
+instance ToJSON (Proof c) where
+ toJSON Proof{..} =
+ JSON.object
+ [ "challenge" .= proof_challenge
+ , "response" .= proof_response
+ ]
+ toEncoding Proof{..} =
+ JSON.pairs
+ ( "challenge" .= proof_challenge
+ <> "response" .= proof_response
+ )
+instance Reifies c FFC => FromJSON (Proof c) where
+ parseJSON = JSON.withObject "TrusteePublicKey" $ \o -> do
+ proof_challenge <- o .: "challenge"
+ proof_response <- o .: "response"
+ return Proof{..}
-- ** Type 'ZKP'
-- | Zero-knowledge proof.
-- , answer_blankProof ::
} deriving (Eq,Show,Generic,NFData)
deriving instance Reifies c FFC => ToJSON (Answer c)
-deriving instance Reifies c FFC => FromJSON (Answer c)
+instance Reifies c FFC => FromJSON (Answer c) where
+ parseJSON = JSON.withObject "Answer" $ \o -> do
+ answer_choices <- o .: "choices"
+ answer_individual_proofs <- o .: "individual_proofs"
+ let answer_opinions = List.zip answer_choices answer_individual_proofs
+ answer_sumProof <- o .: "overall_proof"
+ return Answer{..}
-- | @('encryptAnswer' elecPubKey zkp quest opinions)@
-- returns an 'Answer' validable by 'verifyAnswer',
reify ffc $ \(_::Proxy c) -> k @c
Election{election_crypto = ElectionCrypto_FFC ffc (G (F pubKey)), ..}
-
instance ToJSON (ElectionCrypto c) where
toJSON (ElectionCrypto_FFC ffc pubKey) =
JSON.object
, ballot_election_hash :: !Hash
} deriving (Generic,NFData)
deriving instance Reifies c FFC => ToJSON (Ballot c)
-deriving instance Reifies c FFC => FromJSON (Ballot c)
+instance Reifies c FFC => FromJSON (Ballot c) where
+ parseJSON = JSON.withObject "Ballot" $ \o -> do
+ ballot_answers <- o .: "answers"
+ ballot_signature <- o .:? "signature"
+ ballot_election_uuid <- o .: "election_uuid"
+ ballot_election_hash <- o .: "election_hash"
+ return Ballot{..}
-- | @('encryptBallot' elec ('Just' ballotSecKey) opinionsByQuest)@
-- returns a 'Ballot' signed by 'secKey' (the voter's secret key)
, signature_proof :: !(Proof c)
} deriving (Generic,NFData)
deriving instance Reifies c FFC => ToJSON (Signature c)
-deriving instance Reifies c FFC => FromJSON (Signature c)
+instance Reifies c FFC => FromJSON (Signature c) where
+ parseJSON = JSON.withObject "Signature" $ \o -> do
+ signature_publicKey <- o .: "public_key"
+ proof_challenge <- o .: "challenge"
+ proof_response <- o .: "response"
+ let signature_proof = Proof{..}
+ return Signature{..}
-- *** Hashing
, Just x <- readMaybe (Text.unpack s)
, x < fieldCharac @c
= return (F x)
- parseJSON json = JSON.typeMismatch "F" json
+ parseJSON json = JSON.typeMismatch "FieldElement" json
instance Reifies c FFC => FromNatural (F c) where
fromNatural i = F $ abs $ i `mod` fieldCharac @c
where
, r <- G (F x)
, r ^ E (groupOrder @c) == one
= return r
- parseJSON json = JSON.typeMismatch "G" json
+ parseJSON json = JSON.typeMismatch "GroupElement" json
instance Reifies c FFC => FromNatural (G c) where
fromNatural = G . fromNatural
instance ToNatural (G c) where
, Just x <- readMaybe (Text.unpack s)
, x < groupOrder @c
= return (E x)
- parseJSON json = JSON.typeMismatch "E" json
+ parseJSON json = JSON.typeMismatch "Exponent" json
instance Reifies c FFC => FromNatural (E c) where
fromNatural i =
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-} -- for Reifies instances
module Voting.Protocol.Tally where
import Control.DeepSeq (NFData)
import Control.Monad (Monad(..), mapM, unless)
import Control.Monad.Trans.Except (Except, ExceptT, throwE)
-import Data.Aeson (ToJSON(..),FromJSON(..))
+import Data.Aeson (ToJSON(..),FromJSON(..),(.:),(.=))
import Data.Eq (Eq(..))
-import Data.Function (($))
+import Data.Function (($), (.))
import Data.Functor ((<$>))
import Data.Maybe (maybe)
import Data.Semigroup (Semigroup(..))
-import Data.Tuple (fst)
+import Data.Tuple (fst, snd)
import GHC.Generics (Generic)
import Numeric.Natural (Natural)
-import Prelude (fromIntegral)
import Text.Show (Show(..))
+import qualified Data.Aeson as JSON
+import qualified Data.Aeson.Types as JSON
+import qualified Data.Aeson.Encoding as JSON
import qualified Control.Monad.Trans.State.Strict as S
import qualified Data.ByteString as BS
import qualified Data.List as List
-- returns the sum of the 'Encryption's of the given @ballots@,
-- along with the number of 'Ballot's.
encryptedTally :: Reifies c FFC => [Ballot c] -> (EncryptedTally c, Natural)
-encryptedTally ballots =
- ( List.foldr (\Ballot{..} ->
- List.zipWith (\Answer{..} ->
- List.zipWith (+)
- (fst <$> answer_opinions))
- ballot_answers)
- (List.repeat (List.repeat zero))
- ballots
- , fromIntegral $ List.length ballots
+encryptedTally = List.foldr insertEncryptedTally emptyEncryptedTally
+
+-- | The initial 'EncryptedTally' which tallies no 'Ballot'.
+emptyEncryptedTally :: Reifies c FFC => (EncryptedTally c, Natural)
+emptyEncryptedTally = (List.repeat (List.repeat zero), 0)
+
+-- | @('insertEncryptedTally' ballot encTally)@
+-- returns the 'EncryptedTally' adding the votes of the given @(ballot)@
+-- to those of the given @(encTally)@.
+insertEncryptedTally :: Reifies c FFC => Ballot c -> (EncryptedTally c, Natural) -> (EncryptedTally c, Natural)
+insertEncryptedTally Ballot{..} (encTally, numBallots) =
+ ( List.zipWith
+ (\Answer{..} -> List.zipWith (+) (fst <$> answer_opinions))
+ ballot_answers
+ encTally
+ , numBallots+1
)
-- ** Type 'DecryptionShareCombinator'
-- ** Type 'DecryptionShare'
-- | A decryption share is a 'DecryptionFactor' and a decryption 'Proof', by choice by 'Question'.
-- Computed by a trustee in 'proveDecryptionShare'.
-type DecryptionShare c = [[(DecryptionFactor c, Proof c)]]
+newtype DecryptionShare c = DecryptionShare
+ { unDecryptionShare :: [[(DecryptionFactor c, Proof c)]] }
+ deriving (Eq,Show,Generic)
+deriving newtype instance NFData (DecryptionShare c)
+instance ToJSON (DecryptionShare c) where
+ toJSON (DecryptionShare decByChoiceByQuest) =
+ JSON.object
+ [ "decryption_factors" .=
+ toJSONList (((toJSON . fst) <$>) <$> decByChoiceByQuest)
+ , "decryption_proofs" .=
+ toJSONList (((toJSON . snd) <$>) <$> decByChoiceByQuest)
+ ]
+ toEncoding (DecryptionShare decByChoiceByQuest) =
+ JSON.pairs $
+ JSON.pair "decryption_factors"
+ (JSON.list (JSON.list (toEncoding . fst)) decByChoiceByQuest) <>
+ JSON.pair "decryption_proofs"
+ (JSON.list (JSON.list (toEncoding . snd)) decByChoiceByQuest)
+instance Reifies c FFC => FromJSON (DecryptionShare c) where
+ parseJSON = JSON.withObject "DecryptionShare" $ \o -> do
+ decFactors <- o .: "decryption_factors"
+ decProofs <- o .: "decryption_proofs"
+ let err msg = JSON.typeMismatch ("DecryptionShare: "<>msg) (JSON.Object o)
+ DecryptionShare
+ <$> isoZipWithM (err "inconsistent number of questions")
+ (isoZipWithM (err "inconsistent number of choices")
+ (\a b -> return (a, b)))
+ decFactors decProofs
-- *** Type 'DecryptionFactor'
-- | @'encryption_nonce' '^'trusteeSecKey@
Monad m => Reifies c FFC => RandomGen r =>
EncryptedTally c -> SecretKey c -> S.StateT r m (DecryptionShare c)
proveDecryptionShare encByChoiceByQuest trusteeSecKey =
+ (DecryptionShare <$>) $
(proveDecryptionFactor trusteeSecKey `mapM`) `mapM` encByChoiceByQuest
proveDecryptionFactor ::
Monad m => Reifies c FFC =>
EncryptedTally c -> PublicKey c -> DecryptionShare c ->
ExceptT ErrorTally m ()
-verifyDecryptionShare encByChoiceByQuest trusteePubKey =
+verifyDecryptionShare encByChoiceByQuest trusteePubKey (DecryptionShare decShare) =
let zkp = decryptionShareStatement trusteePubKey in
isoZipWithM_ (throwE ErrorTally_NumberOfQuestions)
(isoZipWithM_ (throwE ErrorTally_NumberOfChoices) $
, commit proof encryption_nonce decFactor
]) $ throwE ErrorTally_WrongProof)
encByChoiceByQuest
+ decShare
verifyDecryptionShareByTrustee ::
Monad m => Reifies c FFC =>
import Control.DeepSeq (NFData)
import Control.Monad (Monad(..), foldM, unless)
import Control.Monad.Trans.Except (ExceptT(..), throwE)
-import Data.Aeson (ToJSON(..),FromJSON(..))
+import Data.Aeson (ToJSON(..),FromJSON(..),(.:),(.=))
import Data.Eq (Eq(..))
import Data.Function (($))
import Data.Functor ((<$>))
import GHC.Generics (Generic)
import Text.Show (Show(..))
import qualified Control.Monad.Trans.State.Strict as S
+import qualified Data.Aeson as JSON
import qualified Data.ByteString as BS
import qualified Data.List as List
-- Which is done in 'proveIndispensableTrusteePublicKey'
-- and 'verifyIndispensableTrusteePublicKey'.
} deriving (Eq,Show,Generic,NFData)
-deriving instance Reifies c FFC => ToJSON (TrusteePublicKey c)
-deriving instance Reifies c FFC => FromJSON (TrusteePublicKey c)
+instance ToJSON (TrusteePublicKey c) where
+ toJSON TrusteePublicKey{..} =
+ JSON.object
+ [ "pok" .= trustee_SecretKeyProof
+ , "public_key" .= trustee_PublicKey
+ ]
+ toEncoding TrusteePublicKey{..} =
+ JSON.pairs
+ ( "pok" .= trustee_SecretKeyProof
+ <> "public_key" .= trustee_PublicKey
+ )
+instance Reifies c FFC => FromJSON (TrusteePublicKey c) where
+ parseJSON = JSON.withObject "TrusteePublicKey" $ \o -> do
+ trustee_PublicKey <- o .: "public_key"
+ trustee_SecretKeyProof <- o .: "pok"
+ return TrusteePublicKey{..}
-- ** Type 'ErrorTrusteePublicKey'
data ErrorTrusteePublicKey
encByChoiceByQuest
pubKeyByTrustee
decByChoiceByQuestByTrustee
- (dec0,decs) <-
+ (DecryptionShare dec0,decs) <-
maybe (throwE ErrorTally_NumberOfTrustees) return $
List.uncons decByChoiceByQuestByTrustee
foldM (isoZipWithM (throwE ErrorTally_NumberOfQuestions)
(maybe (throwE ErrorTally_NumberOfChoices) return `o2`
isoZipWith (\a (decFactor, _proof) -> a * decFactor)))
- ((fst <$>) <$> dec0) decs
+ ((fst <$>) <$> dec0) (unDecryptionShare <$> decs)
sourcephile / git / majurity.git / commitdiff