-- | ElGamal-like encryption.
data Encryption q = Encryption
{ encryption_nonce :: G q
- -- ^ Public part of the random 'secNonce': @('groupGen''^'r)@
+ -- ^ Public part of the random 'secNonce': @('groupGen' '^'r)@
, encryption_vault :: G q
- -- ^ Encrypted opinion: @('pubKey''^'r '*' 'groupGen''^'opinion)@
+ -- ^ Encrypted opinion: @('pubKey' '^'r '*' 'groupGen' '^'opinion)@
} deriving (Eq,Show)
-- | Additive homomorphism.
--- Using the fact that: @'groupGen''^'x '*' 'groupGen''^'y '==' 'groupGen''^'(x'+'y)@.
+-- Using the fact that: @'groupGen' '^'x '*' 'groupGen' '^'y '==' 'groupGen' '^'(x'+'y)@.
instance SubGroup q => Additive (Encryption q) where
zero = Encryption one one
x+y = Encryption
(encryption_nonce x * encryption_nonce y)
(encryption_vault x * encryption_vault y)
+-- ** Type 'PublicKey'
type PublicKey = G
+-- ** Type 'SecretKey'
type SecretKey = E
+-- *** Type 'SecretNonce'
type SecretNonce = E
+-- ** Type 'ZKP'
+-- | Zero-knowledge proof
type ZKP = BS.ByteString
-- ** Type 'Opinion'
type Commitment = G
-- ** Type 'Disjunction'
--- | A 'Disjunction' is an 'inv'ersed @'groupGen''^'opinion@
+-- | A 'Disjunction' is an 'inv'ersed @('groupGen' '^'opinion)@
-- it's used in 'proveEncryption' to generate a 'Proof'
--- that an 'encryption_vault' contains a given @'groupGen''^'opinion@,
+-- that an 'encryption_vault' contains a given @('groupGen' '^'opinion)@,
type Disjunction = G
-validBool :: SubGroup q => ML.MeasuredList 2 (Disjunction q)
-validBool = fromJust $ ML.fromList $ List.take 2 groupGenInverses
+booleanDisjunctions :: SubGroup q => ML.MeasuredList 2 (Disjunction q)
+booleanDisjunctions = fromJust $ ML.fromList $ List.take 2 groupGenInverses
-validRange ::
+intervalDisjunctions ::
forall q mini maxi.
SubGroup q =>
Bounds mini maxi ->
ML.MeasuredList (maxi-mini) (Disjunction q)
-validRange Bounds{}
+intervalDisjunctions Bounds{}
| Constraint.Proof <- (Nat.<=) @mini @maxi =
fromJust $
ML.fromList $
groupGenInverses
-- ** Type 'ValidityProof'
--- | A list of 'Proof' to prove that the 'Opinion' within an 'Encryption'
+-- | A list of 'Proof's to prove that the 'Opinion' within an 'Encryption'
-- is indexing a 'Disjunction' within a list of them,
-- without knowing which 'Opinion' it is.
-newtype ValidityProof n q = ValidityProof (ML.MeasuredList n (Proof q))
+newtype ValidityProof disjs q = ValidityProof (ML.MeasuredList disjs (Proof q))
deriving (Eq,Show)
encryptionStatement :: SubGroup q => ZKP -> Encryption q -> BS.ByteString
fromString (show (natG encryption_vault))<>"|"
proveEncryption ::
- forall ds m r q.
- Nat.Known ds =>
+ forall disjs m r q.
+ Nat.Known disjs =>
Monad m => RandomGen r => SubGroup q =>
PublicKey q -> ZKP ->
- ML.MeasuredList ds (Disjunction q) -> Opinion ds ->
+ ML.MeasuredList disjs (Disjunction q) -> Opinion disjs ->
(SecretNonce q, Encryption q) ->
- S.StateT r m (ValidityProof ds q)
+ S.StateT r m (ValidityProof disjs q)
proveEncryption pubKey zkp disjs
(Nat.Index (o::Proxy o))
(secNonce, enc@Encryption{..})
-- NOTE: the 'Constraint.Proof's below are needed to prove
-- that the returned 'ValidityProof' has the same length
-- than the given list of 'Disjunction's.
- | Constraint.Proof <- (Nat.+<=) @o @1 @ds -- prove that o+1<=ds implies 1<=ds-o and o<=ds
- , Constraint.Proof <- (Nat.<=) @o @ds -- prove that o<=ds implies ds-o is a Natural and o+(ds-o) ~ ds
- , Constraint.Proof <- (Nat.<=) @1 @(ds-o) -- prove that ((ds-o)-1)+1 ~ ds-o
+ | Constraint.Proof <- (Nat.+<=) @o @1 @disjs -- prove that o+1<=disjs implies 1<=disjs-o and o<=disjs
+ , Constraint.Proof <- (Nat.<=) @o @disjs -- prove that o<=disjs implies disjs-o is a Natural and o+(disjs-o) ~ disjs
+ , Constraint.Proof <- (Nat.<=) @1 @(disjs-o) -- prove that ((disjs-o)-1)+1 ~ disjs-o
= do
let (prevDisjs, ML.uncons -> (_indexedDisj,nextDisjs)) = ML.splitAt o disjs
prevFakes <- fakeProof `mapM` prevDisjs
sum (proof_challenge . fst <$> prevFakes) +
sum (proof_challenge . fst <$> nextFakes)
genuineProof <- nizkProof secNonce [groupGen, pubKey] $
- -- | 'Oracle'
+ -- 'Oracle'
\nizkCommitments ->
let commitments =
foldMap snd prevFakes <>
encryptions <- encrypt pubKey `mapM` opinions
individualProofs <-
sequence $ ML.zipWith
- (proveEncryption pubKey zkp validBool)
+ (proveEncryption pubKey zkp booleanDisjunctions)
opinions encryptions
sumProof <-
proveEncryption pubKey zkp
- (validRange question_bounds)
+ (intervalDisjunctions question_bounds)
(Nat.Index $ Proxy @(opinionsSum-mini))
( sum (fst <$> encryptions)
, sum (snd <$> encryptions) )
Question choices mini maxi q ->
Answer choices mini maxi q -> Bool
validateAnswer pubKey zkp Question{..} Answer{..} =
- and (validateEncryption pubKey zkp validBool <$> answer_opinions) &&
+ and (validateEncryption pubKey zkp booleanDisjunctions <$> answer_opinions) &&
validateEncryption pubKey zkp
- (validRange question_bounds)
+ (intervalDisjunctions question_bounds)
( sum (fst <$> answer_opinions)
, answer_sumProof )
, ballot_signature
}
+validateBallot ::
+ SubGroup q =>
+ Election quests choices mini maxi q ->
+ Ballot quests choices mini maxi q ->
+ Bool
+validateBallot Election{..} Ballot{..} =
+ ballot_election_uuid == election_uuid &&
+ ballot_election_hash == election_hash &&
+ let (validSign, zkp) =
+ case ballot_signature of
+ Nothing -> (True, "")
+ Just (Signature pubKey Proof{..}) ->
+ let zkp = fromString (show (natG pubKey)) in
+ let validSign =
+ let commitment = groupGen ^ proof_response * pubKey ^ proof_challenge in
+ let prefix = signatureCommitments zkp commitment in
+ let contents = signatureStatement ballot_answers in
+ hash prefix contents == proof_challenge
+ in (validSign, zkp)
+ in
+ validSign &&
+ and (ML.zipWith (validateAnswer election_publicKey zkp)
+ election_questions ballot_answers)
+
-- ** Type 'Signature'
-- | Schnorr-like signature.
--
sourcephile / git / majurity.git / commitdiff