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(..))
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.Text (Text)
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
-- ^ Encrypted 'clear' text,
-- 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 => 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"
+ 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.
let proof_challenge = oracle commitments
return Proof
{ proof_challenge
- , proof_response = nonce - sec*proof_challenge
+ , proof_response = nonce + sec*proof_challenge
+ -- TODO: switch (+) to (-) when 'commit' will switch (/) to (*).
}
-- | @('fakeProof')@ returns a 'Proof'
-- 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 #-}
-- * Type 'Disjunction'
, 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
-- is an element of @[mini..maxi]@.
-- , 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 => 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"
+ 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',
<> "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"
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
[ "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))
deriving newtype NFData
hashJSON :: ToJSON a => a -> Hash
-hashJSON = Hash . TL.toStrict . TL.decodeUtf8 . BSL64.encode . JSON.encode
+hashJSON = Hash . hexHash . BSL.toStrict . BSL64.encode . JSON.encode
hashElection :: Election c -> Election c
hashElection elec = elec{election_hash=hashJSON elec}
, ballot_election_uuid :: !UUID
, 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 => 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"
+ 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)
-- ^ Verification 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 => 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"
+ proof_challenge <- o .: "challenge"
+ proof_response <- o .: "response"
+ let signature_proof = Proof{..}
+ return Signature{..}
-- *** Hashing
sourcephile / git / majurity.git / blobdiff