{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-} -- for readElection
{-# LANGUAGE UndecidableInstances #-} -- for Reifies constraints in instances
module Voting.Protocol.Election where

import Control.DeepSeq (NFData)
import Control.Monad (Monad(..), zipWithM)
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Trans.Except (ExceptT(..), runExcept, throwE, withExceptT)
import Data.Aeson (ToJSON(..),FromJSON(..),(.:),(.:?),(.=))
import Data.Bool
import Data.Either (either)
import Data.Eq (Eq(..))
import Data.Foldable (foldMap, and)
import Data.Function (($), (.), id, const)
import Data.Functor ((<$>))
import Data.Functor.Identity (Identity(..))
import Data.Maybe (Maybe(..), maybe, fromJust, fromMaybe)
import Data.Monoid (Monoid(..))
import Data.Ord (Ord(..))
import Data.Proxy (Proxy(..))
import Data.Reflection (Reifies(..), reify)
import Data.Semigroup (Semigroup(..))
import Data.String (String)
import Data.Text (Text)
import Data.Traversable (Traversable(..))
import Data.Tuple (fst, snd)
import GHC.Generics (Generic)
import GHC.Natural (minusNaturalMaybe)
import Numeric.Natural (Natural)
import Prelude (fromIntegral)
import System.IO (IO, FilePath)
import System.Random (RandomGen)
import Text.Show (Show(..))
import qualified Control.Monad.Trans.State.Strict as S
import qualified Data.Aeson as JSON
import qualified Data.Aeson.Encoding as JSON
import qualified Data.Aeson.Internal as JSON
import qualified Data.Aeson.Parser.Internal as JSON
import qualified Data.Aeson.Types as JSON
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.List as List

import Voting.Protocol.Utils
import Voting.Protocol.Arithmetic
import Voting.Protocol.Version
import Voting.Protocol.Credential
import Voting.Protocol.Cryptography

-- * Type 'Question'
data Question v = Question
 { Question v -> Text
question_text    :: !Text
 , Question v -> [Text]
question_choices :: ![Text]
 , Question v -> Natural
question_mini    :: !Natural
 , Question v -> Natural
question_maxi    :: !Natural
 -- , question_blank :: Maybe Bool
 } deriving (Question v -> Question v -> Bool
(Question v -> Question v -> Bool)
-> (Question v -> Question v -> Bool) -> Eq (Question v)
forall v. Question v -> Question v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Question v -> Question v -> Bool
$c/= :: forall v. Question v -> Question v -> Bool
== :: Question v -> Question v -> Bool
$c== :: forall v. Question v -> Question v -> Bool
Eq,Int -> Question v -> ShowS
[Question v] -> ShowS
Question v -> String
(Int -> Question v -> ShowS)
-> (Question v -> String)
-> ([Question v] -> ShowS)
-> Show (Question v)
forall v. Int -> Question v -> ShowS
forall v. [Question v] -> ShowS
forall v. Question v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Question v] -> ShowS
$cshowList :: forall v. [Question v] -> ShowS
show :: Question v -> String
$cshow :: forall v. Question v -> String
showsPrec :: Int -> Question v -> ShowS
$cshowsPrec :: forall v. Int -> Question v -> ShowS
Show,(forall x. Question v -> Rep (Question v) x)
-> (forall x. Rep (Question v) x -> Question v)
-> Generic (Question v)
forall x. Rep (Question v) x -> Question v
forall x. Question v -> Rep (Question v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v x. Rep (Question v) x -> Question v
forall v x. Question v -> Rep (Question v) x
$cto :: forall v x. Rep (Question v) x -> Question v
$cfrom :: forall v x. Question v -> Rep (Question v) x
Generic,Question v -> ()
(Question v -> ()) -> NFData (Question v)
forall v. Question v -> ()
forall a. (a -> ()) -> NFData a
rnf :: Question v -> ()
$crnf :: forall v. Question v -> ()
NFData)
instance Reifies v Version => ToJSON (Question v) where
	toJSON :: Question v -> Value
toJSON Question{Natural
[Text]
Text
question_maxi :: Natural
question_mini :: Natural
question_choices :: [Text]
question_text :: Text
question_maxi :: forall v. Question v -> Natural
question_mini :: forall v. Question v -> Natural
question_choices :: forall v. Question v -> [Text]
question_text :: forall v. Question v -> Text
..} =
		[Pair] -> Value
JSON.object
		 [ Text
"question" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
question_text
		 , Text
"answers"  Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
question_choices
		 , Text
"min"      Text -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Natural
question_mini
		 , Text
"max"      Text -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Natural
question_maxi
		 ]
	toEncoding :: Question v -> Encoding
toEncoding Question{Natural
[Text]
Text
question_maxi :: Natural
question_mini :: Natural
question_choices :: [Text]
question_text :: Text
question_maxi :: forall v. Question v -> Natural
question_mini :: forall v. Question v -> Natural
question_choices :: forall v. Question v -> [Text]
question_text :: forall v. Question v -> Text
..} =
		Series -> Encoding
JSON.pairs
		 (  Text
"question" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
question_text
		 Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
"answers"  Text -> [Text] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
question_choices
		 Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
"min"      Text -> Natural -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Natural
question_mini
		 Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
"max"      Text -> Natural -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Natural
question_maxi
		 )
instance Reifies v Version => FromJSON (Question v) where
	parseJSON :: Value -> Parser (Question v)
parseJSON = String
-> (Object -> Parser (Question v)) -> Value -> Parser (Question v)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Question" ((Object -> Parser (Question v)) -> Value -> Parser (Question v))
-> (Object -> Parser (Question v)) -> Value -> Parser (Question v)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
		Text
question_text    <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"question"
		[Text]
question_choices <- Object
o Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"answers"
		Natural
question_mini    <- Object
o Object -> Text -> Parser Natural
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"min"
		Natural
question_maxi    <- Object
o Object -> Text -> Parser Natural
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"max"
		Question v -> Parser (Question v)
forall (m :: * -> *) a. Monad m => a -> m a
return Question :: forall v. Text -> [Text] -> Natural -> Natural -> Question v
Question{Natural
[Text]
Text
question_maxi :: Natural
question_mini :: Natural
question_choices :: [Text]
question_text :: Text
question_maxi :: Natural
question_mini :: Natural
question_choices :: [Text]
question_text :: Text
..}

-- * Type 'Answer'
data Answer crypto v c = Answer
 { Answer crypto v c
-> [(Encryption crypto v c, DisjProof crypto v c)]
answer_opinions :: ![(Encryption crypto v c, DisjProof crypto v c)]
   -- ^ Encrypted 'Opinion' for each 'question_choices'
   -- with a 'DisjProof' that they belong to [0,1].
 , Answer crypto v c -> DisjProof crypto v c
answer_sumProof :: !(DisjProof crypto v c)
   -- ^ Proofs that the sum of the 'Opinon's encrypted in 'answer_opinions'
   -- is an element of @[mini..maxi]@.
 -- , answer_blankProof ::
 } deriving ((forall x. Answer crypto v c -> Rep (Answer crypto v c) x)
-> (forall x. Rep (Answer crypto v c) x -> Answer crypto v c)
-> Generic (Answer crypto v c)
forall x. Rep (Answer crypto v c) x -> Answer crypto v c
forall x. Answer crypto v c -> Rep (Answer crypto v c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto v c x. Rep (Answer crypto v c) x -> Answer crypto v c
forall crypto v c x. Answer crypto v c -> Rep (Answer crypto v c) x
$cto :: forall crypto v c x. Rep (Answer crypto v c) x -> Answer crypto v c
$cfrom :: forall crypto v c x. Answer crypto v c -> Rep (Answer crypto v c) x
Generic)
deriving instance Eq (G crypto c) => Eq (Answer crypto v c)
deriving instance (Show (G crypto c), Show (G crypto c)) => Show (Answer crypto v c)
deriving instance NFData (G crypto c) => NFData (Answer crypto v c)
instance
 ( Reifies v Version
 , CryptoParams crypto c
 ) => ToJSON (Answer crypto v c) where
	toJSON :: Answer crypto v c -> Value
toJSON Answer{[(Encryption crypto v c, DisjProof crypto v c)]
DisjProof crypto v c
answer_sumProof :: DisjProof crypto v c
answer_opinions :: [(Encryption crypto v c, DisjProof crypto v c)]
answer_sumProof :: forall crypto v c. Answer crypto v c -> DisjProof crypto v c
answer_opinions :: forall crypto v c.
Answer crypto v c
-> [(Encryption crypto v c, DisjProof crypto v c)]
..} =
		let ([Encryption crypto v c]
answer_choices, [DisjProof crypto v c]
answer_individual_proofs) =
			[(Encryption crypto v c, DisjProof crypto v c)]
-> ([Encryption crypto v c], [DisjProof crypto v c])
forall a b. [(a, b)] -> ([a], [b])
List.unzip [(Encryption crypto v c, DisjProof crypto v c)]
answer_opinions in
		[Pair] -> Value
JSON.object
		 [ Text
"choices"           Text -> [Encryption crypto v c] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Encryption crypto v c]
answer_choices
		 , Text
"individual_proofs" Text -> [DisjProof crypto v c] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [DisjProof crypto v c]
answer_individual_proofs
		 , Text
"overall_proof"     Text -> DisjProof crypto v c -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= DisjProof crypto v c
answer_sumProof
		 ]
	toEncoding :: Answer crypto v c -> Encoding
toEncoding Answer{[(Encryption crypto v c, DisjProof crypto v c)]
DisjProof crypto v c
answer_sumProof :: DisjProof crypto v c
answer_opinions :: [(Encryption crypto v c, DisjProof crypto v c)]
answer_sumProof :: forall crypto v c. Answer crypto v c -> DisjProof crypto v c
answer_opinions :: forall crypto v c.
Answer crypto v c
-> [(Encryption crypto v c, DisjProof crypto v c)]
..} =
		let ([Encryption crypto v c]
answer_choices, [DisjProof crypto v c]
answer_individual_proofs) =
			[(Encryption crypto v c, DisjProof crypto v c)]
-> ([Encryption crypto v c], [DisjProof crypto v c])
forall a b. [(a, b)] -> ([a], [b])
List.unzip [(Encryption crypto v c, DisjProof crypto v c)]
answer_opinions in
		Series -> Encoding
JSON.pairs
		 (  Text
"choices"           Text -> [Encryption crypto v c] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Encryption crypto v c]
answer_choices
		 Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
"individual_proofs" Text -> [DisjProof crypto v c] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [DisjProof crypto v c]
answer_individual_proofs
		 Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
"overall_proof"     Text -> DisjProof crypto v c -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= DisjProof crypto v c
answer_sumProof
		 )
instance
 ( Reifies v Version
 , CryptoParams crypto c
 ) => FromJSON (Answer crypto v c) where
	parseJSON :: Value -> Parser (Answer crypto v c)
parseJSON = String
-> (Object -> Parser (Answer crypto v c))
-> Value
-> Parser (Answer crypto v c)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Answer" ((Object -> Parser (Answer crypto v c))
 -> Value -> Parser (Answer crypto v c))
-> (Object -> Parser (Answer crypto v c))
-> Value
-> Parser (Answer crypto v c)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
		[Encryption crypto v c]
answer_choices <- Object
o Object -> Text -> Parser [Encryption crypto v c]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"choices"
		[DisjProof crypto v c]
answer_individual_proofs <- Object
o Object -> Text -> Parser [DisjProof crypto v c]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"individual_proofs"
		let answer_opinions :: [(Encryption crypto v c, DisjProof crypto v c)]
answer_opinions = [Encryption crypto v c]
-> [DisjProof crypto v c]
-> [(Encryption crypto v c, DisjProof crypto v c)]
forall a b. [a] -> [b] -> [(a, b)]
List.zip [Encryption crypto v c]
answer_choices [DisjProof crypto v c]
answer_individual_proofs
		DisjProof crypto v c
answer_sumProof <- Object
o Object -> Text -> Parser (DisjProof crypto v c)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"overall_proof"
		Answer crypto v c -> Parser (Answer crypto v c)
forall (m :: * -> *) a. Monad m => a -> m a
return Answer :: forall crypto v c.
[(Encryption crypto v c, DisjProof crypto v c)]
-> DisjProof crypto v c -> Answer crypto v c
Answer{[(Encryption crypto v c, DisjProof crypto v c)]
DisjProof crypto v c
answer_sumProof :: DisjProof crypto v c
answer_opinions :: [(Encryption crypto v c, DisjProof crypto v c)]
answer_sumProof :: DisjProof crypto v c
answer_opinions :: [(Encryption crypto v c, DisjProof crypto v c)]
..}

-- | @('encryptAnswer' elecPubKey zkp quest opinions)@
-- returns an 'Answer' validable by 'verifyAnswer',
-- unless an 'ErrorAnswer' is returned.
encryptAnswer ::
 Reifies v Version =>
 CryptoParams crypto c =>
 Monad m => RandomGen r =>
 PublicKey crypto c -> ZKP ->
 Question v -> [Bool] ->
 S.StateT r (ExceptT ErrorAnswer m) (Answer crypto v c)
encryptAnswer :: PublicKey crypto c
-> ZKP
-> Question v
-> [Bool]
-> StateT r (ExceptT ErrorAnswer m) (Answer crypto v c)
encryptAnswer (PublicKey crypto c
elecPubKey::PublicKey crypto c) ZKP
zkp Question{Natural
[Text]
Text
question_maxi :: Natural
question_mini :: Natural
question_choices :: [Text]
question_text :: Text
question_maxi :: forall v. Question v -> Natural
question_mini :: forall v. Question v -> Natural
question_choices :: forall v. Question v -> [Text]
question_text :: forall v. Question v -> Text
..} [Bool]
opinionByChoice
 | Bool -> Bool
not (Natural
question_mini Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
opinionsSum Bool -> Bool -> Bool
&& Natural
opinionsSum Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
question_maxi) =
	ExceptT ErrorAnswer m (Answer crypto v c)
-> StateT r (ExceptT ErrorAnswer m) (Answer crypto v c)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT ErrorAnswer m (Answer crypto v c)
 -> StateT r (ExceptT ErrorAnswer m) (Answer crypto v c))
-> ExceptT ErrorAnswer m (Answer crypto v c)
-> StateT r (ExceptT ErrorAnswer m) (Answer crypto v c)
forall a b. (a -> b) -> a -> b
$ ErrorAnswer -> ExceptT ErrorAnswer m (Answer crypto v c)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (ErrorAnswer -> ExceptT ErrorAnswer m (Answer crypto v c))
-> ErrorAnswer -> ExceptT ErrorAnswer m (Answer crypto v c)
forall a b. (a -> b) -> a -> b
$
		Natural -> Natural -> Natural -> ErrorAnswer
ErrorAnswer_WrongSumOfOpinions Natural
opinionsSum Natural
question_mini Natural
question_maxi
 | [E crypto c] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [E crypto c]
opinions Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [Text]
question_choices =
	ExceptT ErrorAnswer m (Answer crypto v c)
-> StateT r (ExceptT ErrorAnswer m) (Answer crypto v c)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT ErrorAnswer m (Answer crypto v c)
 -> StateT r (ExceptT ErrorAnswer m) (Answer crypto v c))
-> ExceptT ErrorAnswer m (Answer crypto v c)
-> StateT r (ExceptT ErrorAnswer m) (Answer crypto v c)
forall a b. (a -> b) -> a -> b
$ ErrorAnswer -> ExceptT ErrorAnswer m (Answer crypto v c)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (ErrorAnswer -> ExceptT ErrorAnswer m (Answer crypto v c))
-> ErrorAnswer -> ExceptT ErrorAnswer m (Answer crypto v c)
forall a b. (a -> b) -> a -> b
$
		Natural -> Natural -> ErrorAnswer
ErrorAnswer_WrongNumberOfOpinions
		 (Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> Int -> Natural
forall a b. (a -> b) -> a -> b
$ [E crypto c] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [E crypto c]
opinions)
		 (Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> Int -> Natural
forall a b. (a -> b) -> a -> b
$ [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [Text]
question_choices)
 | Bool
otherwise = do
	[(E crypto c, Encryption crypto v c)]
encryptions <- PublicKey crypto c
-> E crypto c
-> StateT
     r (ExceptT ErrorAnswer m) (E crypto c, Encryption crypto v c)
forall k (v :: k) crypto c (m :: * -> *) r.
(Reifies v Version, CryptoParams crypto c, Monad m, RandomGen r) =>
PublicKey crypto c
-> E crypto c -> StateT r m (E crypto c, Encryption crypto v c)
encrypt PublicKey crypto c
elecPubKey (E crypto c
 -> StateT
      r (ExceptT ErrorAnswer m) (E crypto c, Encryption crypto v c))
-> [E crypto c]
-> StateT
     r (ExceptT ErrorAnswer m) [(E crypto c, Encryption crypto v c)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
`mapM` [E crypto c]
opinions
	[DisjProof crypto v c]
individualProofs <- (Bool
 -> (E crypto c, Encryption crypto v c)
 -> StateT r (ExceptT ErrorAnswer m) (DisjProof crypto v c))
-> [Bool]
-> [(E crypto c, Encryption crypto v c)]
-> StateT r (ExceptT ErrorAnswer m) [DisjProof crypto v c]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM
	 (\Bool
opinion -> PublicKey crypto c
-> ZKP
-> ([PublicKey crypto c], [PublicKey crypto c])
-> (E crypto c, Encryption crypto v c)
-> StateT r (ExceptT ErrorAnswer m) (DisjProof crypto v c)
forall k (v :: k) crypto c (m :: * -> *) r.
(Reifies v Version, CryptoParams crypto c, Monad m, RandomGen r) =>
PublicKey crypto c
-> ZKP
-> ([PublicKey crypto c], [PublicKey crypto c])
-> (EncryptionNonce crypto c, Encryption crypto v c)
-> StateT r m (DisjProof crypto v c)
proveEncryption PublicKey crypto c
elecPubKey ZKP
zkp (([PublicKey crypto c], [PublicKey crypto c])
 -> (E crypto c, Encryption crypto v c)
 -> StateT r (ExceptT ErrorAnswer m) (DisjProof crypto v c))
-> ([PublicKey crypto c], [PublicKey crypto c])
-> (E crypto c, Encryption crypto v c)
-> StateT r (ExceptT ErrorAnswer m) (DisjProof crypto v c)
forall a b. (a -> b) -> a -> b
$
		if Bool
opinion
		then ([PublicKey crypto c] -> [PublicKey crypto c]
forall a. [a] -> [a]
List.init [PublicKey crypto c]
forall crypto c. CryptoParams crypto c => [Disjunction crypto c]
booleanDisjunctions,[])
		else ([],[PublicKey crypto c] -> [PublicKey crypto c]
forall a. [a] -> [a]
List.tail [PublicKey crypto c]
forall crypto c. CryptoParams crypto c => [Disjunction crypto c]
booleanDisjunctions))
	 [Bool]
opinionByChoice [(E crypto c, Encryption crypto v c)]
encryptions
	DisjProof crypto v c
sumProof <- PublicKey crypto c
-> ZKP
-> ([PublicKey crypto c], [PublicKey crypto c])
-> (E crypto c, Encryption crypto v c)
-> StateT r (ExceptT ErrorAnswer m) (DisjProof crypto v c)
forall k (v :: k) crypto c (m :: * -> *) r.
(Reifies v Version, CryptoParams crypto c, Monad m, RandomGen r) =>
PublicKey crypto c
-> ZKP
-> ([PublicKey crypto c], [PublicKey crypto c])
-> (EncryptionNonce crypto c, Encryption crypto v c)
-> StateT r m (DisjProof crypto v c)
proveEncryption PublicKey crypto c
elecPubKey ZKP
zkp
	 ([PublicKey crypto c] -> [PublicKey crypto c]
forall a. [a] -> [a]
List.tail ([PublicKey crypto c] -> [PublicKey crypto c])
-> ([PublicKey crypto c], [PublicKey crypto c])
-> ([PublicKey crypto c], [PublicKey crypto c])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural
-> [PublicKey crypto c]
-> ([PublicKey crypto c], [PublicKey crypto c])
forall i a. Integral i => i -> [a] -> ([a], [a])
List.genericSplitAt
		 (Maybe Natural -> Natural
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Natural -> Natural) -> Maybe Natural -> Natural
forall a b. (a -> b) -> a -> b
$ Natural
opinionsSumNatural -> Natural -> Maybe Natural
`minusNaturalMaybe`Natural
question_mini)
		 (Natural -> Natural -> [PublicKey crypto c]
forall crypto c.
CryptoParams crypto c =>
Natural -> Natural -> [Disjunction crypto c]
intervalDisjunctions Natural
question_mini Natural
question_maxi))
	 ( [E crypto c] -> E crypto c
forall a (f :: * -> *). (Additive a, Foldable f) => f a -> a
sum ((E crypto c, Encryption crypto v c) -> E crypto c
forall a b. (a, b) -> a
fst ((E crypto c, Encryption crypto v c) -> E crypto c)
-> [(E crypto c, Encryption crypto v c)] -> [E crypto c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(E crypto c, Encryption crypto v c)]
encryptions) -- NOTE: sum the 'encNonce's
	 , [Encryption crypto v c] -> Encryption crypto v c
forall a (f :: * -> *). (Additive a, Foldable f) => f a -> a
sum ((E crypto c, Encryption crypto v c) -> Encryption crypto v c
forall a b. (a, b) -> b
snd ((E crypto c, Encryption crypto v c) -> Encryption crypto v c)
-> [(E crypto c, Encryption crypto v c)] -> [Encryption crypto v c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(E crypto c, Encryption crypto v c)]
encryptions) -- NOTE: sum the 'Encryption's
	 )
	Answer crypto v c
-> StateT r (ExceptT ErrorAnswer m) (Answer crypto v c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Answer crypto v c
 -> StateT r (ExceptT ErrorAnswer m) (Answer crypto v c))
-> Answer crypto v c
-> StateT r (ExceptT ErrorAnswer m) (Answer crypto v c)
forall a b. (a -> b) -> a -> b
$ Answer :: forall crypto v c.
[(Encryption crypto v c, DisjProof crypto v c)]
-> DisjProof crypto v c -> Answer crypto v c
Answer
	 { answer_opinions :: [(Encryption crypto v c, DisjProof crypto v c)]
answer_opinions = [Encryption crypto v c]
-> [DisjProof crypto v c]
-> [(Encryption crypto v c, DisjProof crypto v c)]
forall a b. [a] -> [b] -> [(a, b)]
List.zip
		 ((E crypto c, Encryption crypto v c) -> Encryption crypto v c
forall a b. (a, b) -> b
snd ((E crypto c, Encryption crypto v c) -> Encryption crypto v c)
-> [(E crypto c, Encryption crypto v c)] -> [Encryption crypto v c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(E crypto c, Encryption crypto v c)]
encryptions) -- NOTE: drop encNonce
		 [DisjProof crypto v c]
individualProofs
	 , answer_sumProof :: DisjProof crypto v c
answer_sumProof = DisjProof crypto v c
sumProof
	 }
 where
	opinionsSum :: Natural
opinionsSum = [Natural] -> Natural
forall a (f :: * -> *). (Additive a, Foldable f) => f a -> a
sum ([Natural] -> Natural) -> [Natural] -> Natural
forall a b. (a -> b) -> a -> b
$ E crypto c -> Natural
forall a. ToNatural a => a -> Natural
nat (E crypto c -> Natural) -> [E crypto c] -> [Natural]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [E crypto c]
opinions
	opinions :: [E crypto c]
opinions = (\Bool
o -> if Bool
o then E crypto c
forall a. Semiring a => a
one else E crypto c
forall a. Additive a => a
zero) (Bool -> E crypto c) -> [Bool] -> [E crypto c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bool]
opinionByChoice

verifyAnswer ::
 Reifies v Version =>
 CryptoParams crypto c =>
 PublicKey crypto c -> ZKP ->
 Question v -> Answer crypto v c -> Bool
verifyAnswer :: PublicKey crypto c
-> ZKP -> Question v -> Answer crypto v c -> Bool
verifyAnswer (PublicKey crypto c
elecPubKey::PublicKey crypto c) ZKP
zkp Question{Natural
[Text]
Text
question_maxi :: Natural
question_mini :: Natural
question_choices :: [Text]
question_text :: Text
question_maxi :: forall v. Question v -> Natural
question_mini :: forall v. Question v -> Natural
question_choices :: forall v. Question v -> [Text]
question_text :: forall v. Question v -> Text
..} Answer{[(Encryption crypto v c, DisjProof crypto v c)]
DisjProof crypto v c
answer_sumProof :: DisjProof crypto v c
answer_opinions :: [(Encryption crypto v c, DisjProof crypto v c)]
answer_sumProof :: forall crypto v c. Answer crypto v c -> DisjProof crypto v c
answer_opinions :: forall crypto v c.
Answer crypto v c
-> [(Encryption crypto v c, DisjProof crypto v c)]
..}
 | [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [Text]
question_choices Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [(Encryption crypto v c, DisjProof crypto v c)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [(Encryption crypto v c, DisjProof crypto v c)]
answer_opinions = Bool
False
 | Bool
otherwise = do
	(ErrorVerifyEncryption -> Bool)
-> (Bool -> Bool) -> Either ErrorVerifyEncryption Bool -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> ErrorVerifyEncryption -> Bool
forall a b. a -> b -> a
const Bool
False) Bool -> Bool
forall a. a -> a
id (Either ErrorVerifyEncryption Bool -> Bool)
-> Either ErrorVerifyEncryption Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Except ErrorVerifyEncryption Bool
-> Either ErrorVerifyEncryption Bool
forall e a. Except e a -> Either e a
runExcept (Except ErrorVerifyEncryption Bool
 -> Either ErrorVerifyEncryption Bool)
-> Except ErrorVerifyEncryption Bool
-> Either ErrorVerifyEncryption Bool
forall a b. (a -> b) -> a -> b
$ do
		[Bool]
validOpinions <-
			PublicKey crypto c
-> ZKP
-> [PublicKey crypto c]
-> (Encryption crypto v c, DisjProof crypto v c)
-> Except ErrorVerifyEncryption Bool
forall k (v :: k) crypto c (m :: * -> *).
(Reifies v Version, CryptoParams crypto c, Monad m) =>
PublicKey crypto c
-> ZKP
-> [PublicKey crypto c]
-> (Encryption crypto v c, DisjProof crypto v c)
-> ExceptT ErrorVerifyEncryption m Bool
verifyEncryption PublicKey crypto c
elecPubKey ZKP
zkp [PublicKey crypto c]
forall crypto c. CryptoParams crypto c => [Disjunction crypto c]
booleanDisjunctions
			 ((Encryption crypto v c, DisjProof crypto v c)
 -> Except ErrorVerifyEncryption Bool)
-> [(Encryption crypto v c, DisjProof crypto v c)]
-> ExceptT ErrorVerifyEncryption Identity [Bool]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` [(Encryption crypto v c, DisjProof crypto v c)]
answer_opinions
		Bool
validSum <- PublicKey crypto c
-> ZKP
-> [PublicKey crypto c]
-> (Encryption crypto v c, DisjProof crypto v c)
-> Except ErrorVerifyEncryption Bool
forall k (v :: k) crypto c (m :: * -> *).
(Reifies v Version, CryptoParams crypto c, Monad m) =>
PublicKey crypto c
-> ZKP
-> [PublicKey crypto c]
-> (Encryption crypto v c, DisjProof crypto v c)
-> ExceptT ErrorVerifyEncryption m Bool
verifyEncryption PublicKey crypto c
elecPubKey ZKP
zkp
		 (Natural -> Natural -> [PublicKey crypto c]
forall crypto c.
CryptoParams crypto c =>
Natural -> Natural -> [Disjunction crypto c]
intervalDisjunctions Natural
question_mini Natural
question_maxi)
		 ( [Encryption crypto v c] -> Encryption crypto v c
forall a (f :: * -> *). (Additive a, Foldable f) => f a -> a
sum ((Encryption crypto v c, DisjProof crypto v c)
-> Encryption crypto v c
forall a b. (a, b) -> a
fst ((Encryption crypto v c, DisjProof crypto v c)
 -> Encryption crypto v c)
-> [(Encryption crypto v c, DisjProof crypto v c)]
-> [Encryption crypto v c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Encryption crypto v c, DisjProof crypto v c)]
answer_opinions)
		 , DisjProof crypto v c
answer_sumProof )
		Bool -> Except ErrorVerifyEncryption Bool
forall (m :: * -> *) a. Monad m => a -> m a
return ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
validOpinions Bool -> Bool -> Bool
&& Bool
validSum)

-- ** Type 'ErrorAnswer'
-- | Error raised by 'encryptAnswer'.
data ErrorAnswer
 =   ErrorAnswer_WrongNumberOfOpinions Natural Natural
     -- ^ When the number of opinions is different than
     -- the number of choices ('question_choices').
 |   ErrorAnswer_WrongSumOfOpinions Natural Natural Natural
     -- ^ When the sum of opinions is not within the bounds
     -- of 'question_mini' and 'question_maxi'.
 deriving (ErrorAnswer -> ErrorAnswer -> Bool
(ErrorAnswer -> ErrorAnswer -> Bool)
-> (ErrorAnswer -> ErrorAnswer -> Bool) -> Eq ErrorAnswer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorAnswer -> ErrorAnswer -> Bool
$c/= :: ErrorAnswer -> ErrorAnswer -> Bool
== :: ErrorAnswer -> ErrorAnswer -> Bool
$c== :: ErrorAnswer -> ErrorAnswer -> Bool
Eq,Int -> ErrorAnswer -> ShowS
[ErrorAnswer] -> ShowS
ErrorAnswer -> String
(Int -> ErrorAnswer -> ShowS)
-> (ErrorAnswer -> String)
-> ([ErrorAnswer] -> ShowS)
-> Show ErrorAnswer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorAnswer] -> ShowS
$cshowList :: [ErrorAnswer] -> ShowS
show :: ErrorAnswer -> String
$cshow :: ErrorAnswer -> String
showsPrec :: Int -> ErrorAnswer -> ShowS
$cshowsPrec :: Int -> ErrorAnswer -> ShowS
Show,(forall x. ErrorAnswer -> Rep ErrorAnswer x)
-> (forall x. Rep ErrorAnswer x -> ErrorAnswer)
-> Generic ErrorAnswer
forall x. Rep ErrorAnswer x -> ErrorAnswer
forall x. ErrorAnswer -> Rep ErrorAnswer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ErrorAnswer x -> ErrorAnswer
$cfrom :: forall x. ErrorAnswer -> Rep ErrorAnswer x
Generic,ErrorAnswer -> ()
(ErrorAnswer -> ()) -> NFData ErrorAnswer
forall a. (a -> ()) -> NFData a
rnf :: ErrorAnswer -> ()
$crnf :: ErrorAnswer -> ()
NFData)

-- ** Type 'Opinion'
-- | Index of a 'Disjunction' within a list of them.
-- It is encrypted as a 'GroupExponent' by 'encrypt'.
type Opinion = E

-- * Type 'Election'
data Election crypto v c = Election
 { Election crypto v c -> Text
election_name        :: !Text
 , Election crypto v c -> Text
election_description :: !Text
 , Election crypto v c -> [Question v]
election_questions   :: ![Question v]
 , Election crypto v c -> UUID
election_uuid        :: !UUID
 , Election crypto v c -> Base64SHA256
election_hash        :: Base64SHA256
 , Election crypto v c -> crypto
election_crypto      :: !crypto
 , Election crypto v c -> Maybe Version
election_version     :: !(Maybe Version)
 , Election crypto v c -> PublicKey crypto c
election_public_key  :: !(PublicKey crypto c)
 } deriving ((forall x. Election crypto v c -> Rep (Election crypto v c) x)
-> (forall x. Rep (Election crypto v c) x -> Election crypto v c)
-> Generic (Election crypto v c)
forall x. Rep (Election crypto v c) x -> Election crypto v c
forall x. Election crypto v c -> Rep (Election crypto v c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto v c x.
Rep (Election crypto v c) x -> Election crypto v c
forall crypto v c x.
Election crypto v c -> Rep (Election crypto v c) x
$cto :: forall crypto v c x.
Rep (Election crypto v c) x -> Election crypto v c
$cfrom :: forall crypto v c x.
Election crypto v c -> Rep (Election crypto v c) x
Generic)
deriving instance (Eq crypto, Eq (G crypto c)) => Eq (Election crypto v c)
deriving instance (Show crypto, Show (G crypto c)) => Show (Election crypto v c)
deriving instance (NFData crypto, NFData (G crypto c)) => NFData (Election crypto v c)
instance
 ( Reifies v Version
 , CryptoParams crypto c
 , ToJSON crypto
 ) => ToJSON (Election crypto v c) where
	toJSON :: Election crypto v c -> Value
toJSON Election{crypto
[Question v]
Maybe Version
Text
PublicKey crypto c
Base64SHA256
UUID
election_public_key :: PublicKey crypto c
election_version :: Maybe Version
election_crypto :: crypto
election_hash :: Base64SHA256
election_uuid :: UUID
election_questions :: [Question v]
election_description :: Text
election_name :: Text
election_public_key :: forall crypto v c. Election crypto v c -> PublicKey crypto c
election_version :: forall crypto v c. Election crypto v c -> Maybe Version
election_crypto :: forall crypto v c. Election crypto v c -> crypto
election_hash :: forall crypto v c. Election crypto v c -> Base64SHA256
election_uuid :: forall crypto v c. Election crypto v c -> UUID
election_questions :: forall crypto v c. Election crypto v c -> [Question v]
election_description :: forall crypto v c. Election crypto v c -> Text
election_name :: forall crypto v c. Election crypto v c -> Text
..} =
		[Pair] -> Value
JSON.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
		 [ Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
election_name
		 , Text
"description" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
election_description
		 , (Text
"public_key", [Pair] -> Value
JSON.object
			 [ Text
"group" Text -> crypto -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= crypto
election_crypto
			 , Text
"y" Text -> PublicKey crypto c -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PublicKey crypto c
election_public_key
			 ])
		 , Text
"questions" Text -> [Question v] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Question v]
election_questions
		 , Text
"uuid" Text -> UUID -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UUID
election_uuid
		 ] [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<>
		 [Pair] -> (Version -> [Pair]) -> Maybe Version -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Version
version -> [ Text
"version" Text -> Version -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Version
version ]) Maybe Version
election_version
	toEncoding :: Election crypto v c -> Encoding
toEncoding Election{crypto
[Question v]
Maybe Version
Text
PublicKey crypto c
Base64SHA256
UUID
election_public_key :: PublicKey crypto c
election_version :: Maybe Version
election_crypto :: crypto
election_hash :: Base64SHA256
election_uuid :: UUID
election_questions :: [Question v]
election_description :: Text
election_name :: Text
election_public_key :: forall crypto v c. Election crypto v c -> PublicKey crypto c
election_version :: forall crypto v c. Election crypto v c -> Maybe Version
election_crypto :: forall crypto v c. Election crypto v c -> crypto
election_hash :: forall crypto v c. Election crypto v c -> Base64SHA256
election_uuid :: forall crypto v c. Election crypto v c -> UUID
election_questions :: forall crypto v c. Election crypto v c -> [Question v]
election_description :: forall crypto v c. Election crypto v c -> Text
election_name :: forall crypto v c. Election crypto v c -> Text
..} =
		Series -> Encoding
JSON.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
		 (  Text
"name" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
election_name
		 Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
"description" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
election_description
		 Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text -> Encoding -> Series
JSON.pair Text
"public_key" (Series -> Encoding
JSON.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
			Text
"group" Text -> crypto -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= crypto
election_crypto
			Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
"y" Text -> PublicKey crypto c -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PublicKey crypto c
election_public_key
		 )
		 Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
"questions" Text -> [Question v] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Question v]
election_questions
		 Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
"uuid" Text -> UUID -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UUID
election_uuid
		 ) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
		 Series -> (Version -> Series) -> Maybe Version -> Series
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Series
forall a. Monoid a => a
mempty (Text
"version" Text -> Version -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) Maybe Version
election_version

hashElection ::
 Reifies v Version =>
 CryptoParams crypto c =>
 ToJSON crypto =>
 Election crypto v c -> Base64SHA256
hashElection :: Election crypto v c -> Base64SHA256
hashElection = ByteString -> Base64SHA256
base64SHA256 (ByteString -> Base64SHA256)
-> (Election crypto v c -> ByteString)
-> Election crypto v c
-> Base64SHA256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (Election crypto v c -> ByteString)
-> Election crypto v c
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Election crypto v c -> ByteString
forall a. ToJSON a => a -> ByteString
JSON.encode

readElection ::
 forall crypto r.
 FromJSON crypto =>
 ReifyCrypto crypto =>
 FilePath ->
 (forall v c.
	Reifies v Version =>
	CryptoParams crypto c =>
	Election crypto v c -> r) ->
 ExceptT String IO r
readElection :: String
-> (forall v c.
    (Reifies v Version, CryptoParams crypto c) =>
    Election crypto v c -> r)
-> ExceptT String IO r
readElection String
filePath forall v c.
(Reifies v Version, CryptoParams crypto c) =>
Election crypto v c -> r
k = do
	ByteString
fileData <- IO ByteString -> ExceptT String IO ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ByteString -> ExceptT String IO ByteString)
-> IO ByteString -> ExceptT String IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
BS.readFile String
filePath
	IO (Either String r) -> ExceptT String IO r
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String r) -> ExceptT String IO r)
-> IO (Either String r) -> ExceptT String IO r
forall a b. (a -> b) -> a -> b
$ Either String r -> IO (Either String r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String r -> IO (Either String r))
-> Either String r -> IO (Either String r)
forall a b. (a -> b) -> a -> b
$
		Either (JSONPath, String) r -> Either String r
forall a. Either (JSONPath, String) a -> Either String a
jsonEitherFormatError (Either (JSONPath, String) r -> Either String r)
-> Either (JSONPath, String) r -> Either String r
forall a b. (a -> b) -> a -> b
$
			Parser Value
-> (Value -> IResult r)
-> ByteString
-> Either (JSONPath, String) r
forall a.
Parser Value
-> (Value -> IResult a)
-> ByteString
-> Either (JSONPath, String) a
JSON.eitherDecodeStrictWith Parser Value
JSON.jsonEOF
			 ((Value -> Parser r) -> Value -> IResult r
forall a b. (a -> Parser b) -> a -> IResult b
JSON.iparse (ByteString -> Value -> Parser r
parseElection ByteString
fileData))
			 ByteString
fileData
	where
	parseElection :: ByteString -> Value -> Parser r
parseElection ByteString
fileData = String -> (Object -> Parser r) -> Value -> Parser r
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Election" ((Object -> Parser r) -> Value -> Parser r)
-> (Object -> Parser r) -> Value -> Parser r
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
		Maybe Version
election_version <- Object
o Object -> Text -> Parser (Maybe Version)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"version"
		Version
-> (forall s. Reifies s Version => Proxy s -> Parser r) -> Parser r
forall a r. a -> (forall s. Reifies s a => Proxy s -> r) -> r
reify (Version -> Maybe Version -> Version
forall a. a -> Maybe a -> a
fromMaybe Version
stableVersion Maybe Version
election_version) ((forall s. Reifies s Version => Proxy s -> Parser r) -> Parser r)
-> (forall s. Reifies s Version => Proxy s -> Parser r) -> Parser r
forall a b. (a -> b) -> a -> b
$ \(Proxy s
_v::Proxy v) -> do
			(crypto
election_crypto, Value
elecPubKey) <-
				(Value -> Parser (crypto, Value))
-> Object -> Text -> Parser (crypto, Value)
forall a. (Value -> Parser a) -> Object -> Text -> Parser a
JSON.explicitParseField
				 (String
-> (Object -> Parser (crypto, Value))
-> Value
-> Parser (crypto, Value)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"public_key" ((Object -> Parser (crypto, Value))
 -> Value -> Parser (crypto, Value))
-> (Object -> Parser (crypto, Value))
-> Value
-> Parser (crypto, Value)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
						crypto
crypto <- Object
obj Object -> Text -> Parser crypto
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"group"
						Value
pubKey :: JSON.Value <- Object
obj Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"y"
						(crypto, Value) -> Parser (crypto, Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (crypto
crypto, Value
pubKey)
				 ) Object
o Text
"public_key"
			crypto
-> (forall c.
    (Reifies c crypto, CryptoParams crypto c) =>
    Proxy c -> Parser r)
-> Parser r
forall crypto r.
ReifyCrypto crypto =>
crypto
-> (forall c.
    (Reifies c crypto, CryptoParams crypto c) =>
    Proxy c -> r)
-> r
reifyCrypto crypto
election_crypto ((forall c.
  (Reifies c crypto, CryptoParams crypto c) =>
  Proxy c -> Parser r)
 -> Parser r)
-> (forall c.
    (Reifies c crypto, CryptoParams crypto c) =>
    Proxy c -> Parser r)
-> Parser r
forall a b. (a -> b) -> a -> b
$ \(Proxy c
_c::Proxy c) -> do
				Text
election_name <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
				Text
election_description <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"description"
				[Question s]
election_questions <- Object
o Object -> Text -> Parser [Question s]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"questions" :: JSON.Parser [Question v]
				UUID
election_uuid <- Object
o Object -> Text -> Parser UUID
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"uuid"
				PublicKey crypto c
election_public_key :: PublicKey crypto c <- Value -> Parser (PublicKey crypto c)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
elecPubKey
				r -> Parser r
forall (m :: * -> *) a. Monad m => a -> m a
return (r -> Parser r) -> r -> Parser r
forall a b. (a -> b) -> a -> b
$ Election crypto s c -> r
forall v c.
(Reifies v Version, CryptoParams crypto c) =>
Election crypto v c -> r
k (Election crypto s c -> r) -> Election crypto s c -> r
forall a b. (a -> b) -> a -> b
$ Election :: forall crypto v c.
Text
-> Text
-> [Question v]
-> UUID
-> Base64SHA256
-> crypto
-> Maybe Version
-> PublicKey crypto c
-> Election crypto v c
Election
				 { election_questions :: [Question s]
election_questions  = [Question s]
election_questions
				 , election_public_key :: PublicKey crypto c
election_public_key = PublicKey crypto c
election_public_key
				 , election_hash :: Base64SHA256
election_hash       = ByteString -> Base64SHA256
base64SHA256 ByteString
fileData
				 , crypto
Maybe Version
Text
UUID
election_uuid :: UUID
election_description :: Text
election_name :: Text
election_crypto :: crypto
election_version :: Maybe Version
election_version :: Maybe Version
election_crypto :: crypto
election_uuid :: UUID
election_description :: Text
election_name :: Text
..
				 }

-- * Type 'Ballot'
data Ballot crypto v c = Ballot
 { Ballot crypto v c -> [Answer crypto v c]
ballot_answers       :: ![Answer crypto v c]
 , Ballot crypto v c -> Maybe (Signature crypto v c)
ballot_signature     :: !(Maybe (Signature crypto v c))
 , Ballot crypto v c -> UUID
ballot_election_uuid :: !UUID
 , Ballot crypto v c -> Base64SHA256
ballot_election_hash :: !Base64SHA256
 } deriving ((forall x. Ballot crypto v c -> Rep (Ballot crypto v c) x)
-> (forall x. Rep (Ballot crypto v c) x -> Ballot crypto v c)
-> Generic (Ballot crypto v c)
forall x. Rep (Ballot crypto v c) x -> Ballot crypto v c
forall x. Ballot crypto v c -> Rep (Ballot crypto v c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto v c x. Rep (Ballot crypto v c) x -> Ballot crypto v c
forall crypto v c x. Ballot crypto v c -> Rep (Ballot crypto v c) x
$cto :: forall crypto v c x. Rep (Ballot crypto v c) x -> Ballot crypto v c
$cfrom :: forall crypto v c x. Ballot crypto v c -> Rep (Ballot crypto v c) x
Generic)
deriving instance (NFData (G crypto c), NFData crypto) => NFData (Ballot crypto v c)
instance
 ( Reifies v Version
 , CryptoParams crypto c
 , ToJSON (G crypto c)
 ) => ToJSON (Ballot crypto v c) where
	toJSON :: Ballot crypto v c -> Value
toJSON Ballot{[Answer crypto v c]
Maybe (Signature crypto v c)
Base64SHA256
UUID
ballot_election_hash :: Base64SHA256
ballot_election_uuid :: UUID
ballot_signature :: Maybe (Signature crypto v c)
ballot_answers :: [Answer crypto v c]
ballot_election_hash :: forall crypto v c. Ballot crypto v c -> Base64SHA256
ballot_election_uuid :: forall crypto v c. Ballot crypto v c -> UUID
ballot_signature :: forall crypto v c.
Ballot crypto v c -> Maybe (Signature crypto v c)
ballot_answers :: forall crypto v c. Ballot crypto v c -> [Answer crypto v c]
..} =
		[Pair] -> Value
JSON.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
		 [ Text
"answers"       Text -> [Answer crypto v c] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Answer crypto v c]
ballot_answers
		 , Text
"election_uuid" Text -> UUID -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UUID
ballot_election_uuid
		 , Text
"election_hash" Text -> Base64SHA256 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Base64SHA256
ballot_election_hash
		 ] [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<>
		 [Pair]
-> (Signature crypto v c -> [Pair])
-> Maybe (Signature crypto v c)
-> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Signature crypto v c
sig -> [ Text
"signature" Text -> Signature crypto v c -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Signature crypto v c
sig ]) Maybe (Signature crypto v c)
ballot_signature
	toEncoding :: Ballot crypto v c -> Encoding
toEncoding Ballot{[Answer crypto v c]
Maybe (Signature crypto v c)
Base64SHA256
UUID
ballot_election_hash :: Base64SHA256
ballot_election_uuid :: UUID
ballot_signature :: Maybe (Signature crypto v c)
ballot_answers :: [Answer crypto v c]
ballot_election_hash :: forall crypto v c. Ballot crypto v c -> Base64SHA256
ballot_election_uuid :: forall crypto v c. Ballot crypto v c -> UUID
ballot_signature :: forall crypto v c.
Ballot crypto v c -> Maybe (Signature crypto v c)
ballot_answers :: forall crypto v c. Ballot crypto v c -> [Answer crypto v c]
..} =
		Series -> Encoding
JSON.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
		 (  Text
"answers"       Text -> [Answer crypto v c] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Answer crypto v c]
ballot_answers
		 Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
"election_uuid" Text -> UUID -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UUID
ballot_election_uuid
		 Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
"election_hash" Text -> Base64SHA256 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Base64SHA256
ballot_election_hash
		 ) Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
		 Series
-> (Signature crypto v c -> Series)
-> Maybe (Signature crypto v c)
-> Series
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Series
forall a. Monoid a => a
mempty (Text
"signature" Text -> Signature crypto v c -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) Maybe (Signature crypto v c)
ballot_signature
instance
 ( Reifies v Version
 , CryptoParams crypto c
 ) => FromJSON (Ballot crypto v c) where
	parseJSON :: Value -> Parser (Ballot crypto v c)
parseJSON = String
-> (Object -> Parser (Ballot crypto v c))
-> Value
-> Parser (Ballot crypto v c)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Ballot" ((Object -> Parser (Ballot crypto v c))
 -> Value -> Parser (Ballot crypto v c))
-> (Object -> Parser (Ballot crypto v c))
-> Value
-> Parser (Ballot crypto v c)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
		[Answer crypto v c]
ballot_answers       <- Object
o Object -> Text -> Parser [Answer crypto v c]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"answers"
		Maybe (Signature crypto v c)
ballot_signature     <- Object
o Object -> Text -> Parser (Maybe (Signature crypto v c))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"signature"
		UUID
ballot_election_uuid <- Object
o Object -> Text -> Parser UUID
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"election_uuid"
		Base64SHA256
ballot_election_hash <- Object
o Object -> Text -> Parser Base64SHA256
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"election_hash"
		Ballot crypto v c -> Parser (Ballot crypto v c)
forall (m :: * -> *) a. Monad m => a -> m a
return Ballot :: forall crypto v c.
[Answer crypto v c]
-> Maybe (Signature crypto v c)
-> UUID
-> Base64SHA256
-> Ballot crypto v c
Ballot{[Answer crypto v c]
Maybe (Signature crypto v c)
Base64SHA256
UUID
ballot_election_hash :: Base64SHA256
ballot_election_uuid :: UUID
ballot_signature :: Maybe (Signature crypto v c)
ballot_answers :: [Answer crypto v c]
ballot_election_hash :: Base64SHA256
ballot_election_uuid :: UUID
ballot_signature :: Maybe (Signature crypto v c)
ballot_answers :: [Answer crypto v c]
..}

-- | @('encryptBallot' c ('Just' ballotSecKey) opinionsByQuest)@
-- returns a 'Ballot' signed by 'secKey' (the voter's secret key)
-- where 'opinionsByQuest' is a list of 'Opinion's
-- on each 'question_choices' of each 'election_questions'.
encryptBallot ::
 Reifies v Version =>
 CryptoParams crypto c => Key crypto =>
 Monad m => RandomGen r =>
 Election crypto v c ->
 Maybe (SecretKey crypto c) -> [[Bool]] ->
 S.StateT r (ExceptT ErrorBallot m) (Ballot crypto v c)
encryptBallot :: Election crypto v c
-> Maybe (SecretKey crypto c)
-> [[Bool]]
-> StateT r (ExceptT ErrorBallot m) (Ballot crypto v c)
encryptBallot (Election{crypto
[Question v]
Maybe Version
Text
PublicKey crypto c
Base64SHA256
UUID
election_public_key :: PublicKey crypto c
election_version :: Maybe Version
election_crypto :: crypto
election_hash :: Base64SHA256
election_uuid :: UUID
election_questions :: [Question v]
election_description :: Text
election_name :: Text
election_public_key :: forall crypto v c. Election crypto v c -> PublicKey crypto c
election_version :: forall crypto v c. Election crypto v c -> Maybe Version
election_crypto :: forall crypto v c. Election crypto v c -> crypto
election_hash :: forall crypto v c. Election crypto v c -> Base64SHA256
election_uuid :: forall crypto v c. Election crypto v c -> UUID
election_questions :: forall crypto v c. Election crypto v c -> [Question v]
election_description :: forall crypto v c. Election crypto v c -> Text
election_name :: forall crypto v c. Election crypto v c -> Text
..}::Election crypto v c) Maybe (SecretKey crypto c)
ballotSecKeyMay [[Bool]]
opinionsByQuest
 | [Question v] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [Question v]
election_questions Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [[Bool]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [[Bool]]
opinionsByQuest =
	ExceptT ErrorBallot m (Ballot crypto v c)
-> StateT r (ExceptT ErrorBallot m) (Ballot crypto v c)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT ErrorBallot m (Ballot crypto v c)
 -> StateT r (ExceptT ErrorBallot m) (Ballot crypto v c))
-> ExceptT ErrorBallot m (Ballot crypto v c)
-> StateT r (ExceptT ErrorBallot m) (Ballot crypto v c)
forall a b. (a -> b) -> a -> b
$ ErrorBallot -> ExceptT ErrorBallot m (Ballot crypto v c)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (ErrorBallot -> ExceptT ErrorBallot m (Ballot crypto v c))
-> ErrorBallot -> ExceptT ErrorBallot m (Ballot crypto v c)
forall a b. (a -> b) -> a -> b
$
		Natural -> Natural -> ErrorBallot
ErrorBallot_WrongNumberOfAnswers
		 (Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> Int -> Natural
forall a b. (a -> b) -> a -> b
$ [[Bool]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [[Bool]]
opinionsByQuest)
		 (Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> Int -> Natural
forall a b. (a -> b) -> a -> b
$ [Question v] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [Question v]
election_questions)
 | Bool
otherwise = do
	let (Maybe (SecretKey crypto c, PublicKey crypto c)
voterKeys, ZKP
voterZKP) =
		case Maybe (SecretKey crypto c)
ballotSecKeyMay of
		 Maybe (SecretKey crypto c)
Nothing -> (Maybe (SecretKey crypto c, PublicKey crypto c)
forall a. Maybe a
Nothing, ByteString -> ZKP
ZKP ByteString
"")
		 Just SecretKey crypto c
ballotSecKey ->
			( (SecretKey crypto c, PublicKey crypto c)
-> Maybe (SecretKey crypto c, PublicKey crypto c)
forall a. a -> Maybe a
Just (SecretKey crypto c
ballotSecKey, PublicKey crypto c
ballotPubKey)
			, ByteString -> ZKP
ZKP (PublicKey crypto c -> ByteString
forall n. ToNatural n => n -> ByteString
bytesNat PublicKey crypto c
ballotPubKey) )
			where ballotPubKey :: PublicKey crypto c
ballotPubKey = SecretKey crypto c -> PublicKey crypto c
forall crypto c.
(Key crypto, Reifies c crypto) =>
SecretKey crypto c -> PublicKey crypto c
publicKey SecretKey crypto c
ballotSecKey
	[Answer crypto v c]
ballot_answers <-
		(ExceptT ErrorAnswer m ([Answer crypto v c], r)
 -> ExceptT ErrorBallot m ([Answer crypto v c], r))
-> StateT r (ExceptT ErrorAnswer m) [Answer crypto v c]
-> StateT r (ExceptT ErrorBallot m) [Answer crypto v c]
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
S.mapStateT ((ErrorAnswer -> ErrorBallot)
-> ExceptT ErrorAnswer m ([Answer crypto v c], r)
-> ExceptT ErrorBallot m ([Answer crypto v c], r)
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT ErrorAnswer -> ErrorBallot
ErrorBallot_Answer) (StateT r (ExceptT ErrorAnswer m) [Answer crypto v c]
 -> StateT r (ExceptT ErrorBallot m) [Answer crypto v c])
-> StateT r (ExceptT ErrorAnswer m) [Answer crypto v c]
-> StateT r (ExceptT ErrorBallot m) [Answer crypto v c]
forall a b. (a -> b) -> a -> b
$
			(Question v
 -> [Bool] -> StateT r (ExceptT ErrorAnswer m) (Answer crypto v c))
-> [Question v]
-> [[Bool]]
-> StateT r (ExceptT ErrorAnswer m) [Answer crypto v c]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (PublicKey crypto c
-> ZKP
-> Question v
-> [Bool]
-> StateT r (ExceptT ErrorAnswer m) (Answer crypto v c)
forall v crypto c (m :: * -> *) r.
(Reifies v Version, CryptoParams crypto c, Monad m, RandomGen r) =>
PublicKey crypto c
-> ZKP
-> Question v
-> [Bool]
-> StateT r (ExceptT ErrorAnswer m) (Answer crypto v c)
encryptAnswer PublicKey crypto c
election_public_key ZKP
voterZKP)
			 [Question v]
election_questions [[Bool]]
opinionsByQuest
	Maybe (Signature crypto v c)
ballot_signature <- case Maybe (SecretKey crypto c, PublicKey crypto c)
voterKeys of
	 Maybe (SecretKey crypto c, PublicKey crypto c)
Nothing -> Maybe (Signature crypto v c)
-> StateT r (ExceptT ErrorBallot m) (Maybe (Signature crypto v c))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Signature crypto v c)
forall a. Maybe a
Nothing
	 Just (SecretKey crypto c
ballotSecKey, PublicKey crypto c
signature_publicKey) -> do
		Proof crypto v c
signature_proof <-
			SecretKey crypto c
-> Identity (PublicKey crypto c)
-> Oracle Identity crypto c
-> StateT r (ExceptT ErrorBallot m) (Proof crypto v c)
forall k (v :: k) crypto c (m :: * -> *) r (list :: * -> *).
(Reifies v Version, CryptoParams crypto c, Monad m, RandomGen r,
 Functor list) =>
E crypto c
-> list (G crypto c)
-> Oracle list crypto c
-> StateT r m (Proof crypto v c)
proveQuicker SecretKey crypto c
ballotSecKey (PublicKey crypto c -> Identity (PublicKey crypto c)
forall a. a -> Identity a
Identity PublicKey crypto c
forall crypto c. CryptoParams crypto c => G crypto c
groupGen) (Oracle Identity crypto c
 -> StateT r (ExceptT ErrorBallot m) (Proof crypto v c))
-> Oracle Identity crypto c
-> StateT r (ExceptT ErrorBallot m) (Proof crypto v c)
forall a b. (a -> b) -> a -> b
$
			 \(Identity PublicKey crypto c
commitment) ->
				ByteString -> [PublicKey crypto c] -> SecretKey crypto c
forall crypto c.
CryptoParams crypto c =>
ByteString -> [G crypto c] -> E crypto c
hash @crypto
				 -- NOTE: the order is unusual, the commitments are first
				 -- then comes the statement. Best guess is that
				 -- this is easier to code due to their respective types.
				 (ZKP -> PublicKey crypto c -> ByteString
forall crypto c.
(CryptoParams crypto c, ToNatural (G crypto c)) =>
ZKP -> G crypto c -> ByteString
ballotCommitments @crypto ZKP
voterZKP PublicKey crypto c
commitment)
				 ([Answer crypto v c] -> [PublicKey crypto c]
forall crypto c v.
CryptoParams crypto c =>
[Answer crypto v c] -> [G crypto c]
ballotStatement @crypto [Answer crypto v c]
ballot_answers)
		Maybe (Signature crypto v c)
-> StateT r (ExceptT ErrorBallot m) (Maybe (Signature crypto v c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Signature crypto v c)
 -> StateT r (ExceptT ErrorBallot m) (Maybe (Signature crypto v c)))
-> Maybe (Signature crypto v c)
-> StateT r (ExceptT ErrorBallot m) (Maybe (Signature crypto v c))
forall a b. (a -> b) -> a -> b
$ Signature crypto v c -> Maybe (Signature crypto v c)
forall a. a -> Maybe a
Just Signature :: forall k crypto (v :: k) c.
PublicKey crypto c -> Proof crypto v c -> Signature crypto v c
Signature{PublicKey crypto c
Proof crypto v c
signature_proof :: Proof crypto v c
signature_publicKey :: PublicKey crypto c
signature_proof :: Proof crypto v c
signature_publicKey :: PublicKey crypto c
..}
	Ballot crypto v c
-> StateT r (ExceptT ErrorBallot m) (Ballot crypto v c)
forall (m :: * -> *) a. Monad m => a -> m a
return Ballot :: forall crypto v c.
[Answer crypto v c]
-> Maybe (Signature crypto v c)
-> UUID
-> Base64SHA256
-> Ballot crypto v c
Ballot
	 { [Answer crypto v c]
ballot_answers :: [Answer crypto v c]
ballot_answers :: [Answer crypto v c]
ballot_answers
	 , ballot_election_hash :: Base64SHA256
ballot_election_hash = Base64SHA256
election_hash
	 , ballot_election_uuid :: UUID
ballot_election_uuid = UUID
election_uuid
	 , Maybe (Signature crypto v c)
ballot_signature :: Maybe (Signature crypto v c)
ballot_signature :: Maybe (Signature crypto v c)
ballot_signature
	 }

verifyBallot ::
 Reifies v Version =>
 CryptoParams crypto c =>
 Election crypto v c ->
 Ballot crypto v c -> Bool
verifyBallot :: Election crypto v c -> Ballot crypto v c -> Bool
verifyBallot (Election{crypto
[Question v]
Maybe Version
Text
PublicKey crypto c
Base64SHA256
UUID
election_public_key :: PublicKey crypto c
election_version :: Maybe Version
election_crypto :: crypto
election_hash :: Base64SHA256
election_uuid :: UUID
election_questions :: [Question v]
election_description :: Text
election_name :: Text
election_public_key :: forall crypto v c. Election crypto v c -> PublicKey crypto c
election_version :: forall crypto v c. Election crypto v c -> Maybe Version
election_crypto :: forall crypto v c. Election crypto v c -> crypto
election_hash :: forall crypto v c. Election crypto v c -> Base64SHA256
election_uuid :: forall crypto v c. Election crypto v c -> UUID
election_questions :: forall crypto v c. Election crypto v c -> [Question v]
election_description :: forall crypto v c. Election crypto v c -> Text
election_name :: forall crypto v c. Election crypto v c -> Text
..}::Election crypto v c) Ballot{[Answer crypto v c]
Maybe (Signature crypto v c)
Base64SHA256
UUID
ballot_election_hash :: Base64SHA256
ballot_election_uuid :: UUID
ballot_signature :: Maybe (Signature crypto v c)
ballot_answers :: [Answer crypto v c]
ballot_election_hash :: forall crypto v c. Ballot crypto v c -> Base64SHA256
ballot_election_uuid :: forall crypto v c. Ballot crypto v c -> UUID
ballot_signature :: forall crypto v c.
Ballot crypto v c -> Maybe (Signature crypto v c)
ballot_answers :: forall crypto v c. Ballot crypto v c -> [Answer crypto v c]
..} =
	UUID
ballot_election_uuid UUID -> UUID -> Bool
forall a. Eq a => a -> a -> Bool
== UUID
election_uuid Bool -> Bool -> Bool
&&
	Base64SHA256
ballot_election_hash Base64SHA256 -> Base64SHA256 -> Bool
forall a. Eq a => a -> a -> Bool
== Base64SHA256
election_hash Bool -> Bool -> Bool
&&
	[Question v] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [Question v]
election_questions Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Answer crypto v c] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [Answer crypto v c]
ballot_answers Bool -> Bool -> Bool
&&
	let (Bool
isValidSign, ZKP
zkpSign) =
		case Maybe (Signature crypto v c)
ballot_signature of
		 Maybe (Signature crypto v c)
Nothing -> (Bool
True, ByteString -> ZKP
ZKP ByteString
"")
		 Just Signature{PublicKey crypto c
Proof crypto v c
signature_proof :: Proof crypto v c
signature_publicKey :: PublicKey crypto c
signature_proof :: forall crypto k (v :: k) c.
Signature crypto v c -> Proof crypto v c
signature_publicKey :: forall crypto k (v :: k) c.
Signature crypto v c -> PublicKey crypto c
..} ->
			let zkp :: ZKP
zkp = ByteString -> ZKP
ZKP (PublicKey crypto c -> ByteString
forall n. ToNatural n => n -> ByteString
bytesNat PublicKey crypto c
signature_publicKey) in
			(, ZKP
zkp) (Bool -> (Bool, ZKP)) -> Bool -> (Bool, ZKP)
forall a b. (a -> b) -> a -> b
$
				Proof crypto v c -> Challenge crypto c
forall crypto k (v :: k) c. Proof crypto v c -> Challenge crypto c
proof_challenge Proof crypto v c
signature_proof Challenge crypto c -> Challenge crypto c -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> [PublicKey crypto c] -> Challenge crypto c
forall crypto c.
CryptoParams crypto c =>
ByteString -> [G crypto c] -> E crypto c
hash
				 (ZKP -> PublicKey crypto c -> ByteString
forall crypto c.
(CryptoParams crypto c, ToNatural (G crypto c)) =>
ZKP -> G crypto c -> ByteString
ballotCommitments @crypto ZKP
zkp (Proof crypto v c
-> PublicKey crypto c -> PublicKey crypto c -> PublicKey crypto c
forall k crypto c (v :: k).
CryptoParams crypto c =>
Proof crypto v c -> G crypto c -> G crypto c -> G crypto c
commitQuicker Proof crypto v c
signature_proof PublicKey crypto c
forall crypto c. CryptoParams crypto c => G crypto c
groupGen PublicKey crypto c
signature_publicKey))
				 ([Answer crypto v c] -> [PublicKey crypto c]
forall crypto c v.
CryptoParams crypto c =>
[Answer crypto v c] -> [G crypto c]
ballotStatement @crypto [Answer crypto v c]
ballot_answers)
	in
	[Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ Bool
isValidSign Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:
		(Question v -> Answer crypto v c -> Bool)
-> [Question v] -> [Answer crypto v c] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
List.zipWith (PublicKey crypto c
-> ZKP -> Question v -> Answer crypto v c -> Bool
forall v crypto c.
(Reifies v Version, CryptoParams crypto c) =>
PublicKey crypto c
-> ZKP -> Question v -> Answer crypto v c -> Bool
verifyAnswer PublicKey crypto c
election_public_key ZKP
zkpSign)
		 [Question v]
election_questions [Answer crypto v c]
ballot_answers


-- ** Type 'ErrorBallot'
-- | Error raised by 'encryptBallot'.
data ErrorBallot
 =   ErrorBallot_WrongNumberOfAnswers Natural Natural
     -- ^ When the number of answers
     -- is different than the number of questions.
 |   ErrorBallot_Answer ErrorAnswer
     -- ^ When 'encryptAnswer' raised an 'ErrorAnswer'.
 |   ErrorBallot_Wrong
     -- ^ TODO: to be more precise.
 deriving (ErrorBallot -> ErrorBallot -> Bool
(ErrorBallot -> ErrorBallot -> Bool)
-> (ErrorBallot -> ErrorBallot -> Bool) -> Eq ErrorBallot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorBallot -> ErrorBallot -> Bool
$c/= :: ErrorBallot -> ErrorBallot -> Bool
== :: ErrorBallot -> ErrorBallot -> Bool
$c== :: ErrorBallot -> ErrorBallot -> Bool
Eq,Int -> ErrorBallot -> ShowS
[ErrorBallot] -> ShowS
ErrorBallot -> String
(Int -> ErrorBallot -> ShowS)
-> (ErrorBallot -> String)
-> ([ErrorBallot] -> ShowS)
-> Show ErrorBallot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorBallot] -> ShowS
$cshowList :: [ErrorBallot] -> ShowS
show :: ErrorBallot -> String
$cshow :: ErrorBallot -> String
showsPrec :: Int -> ErrorBallot -> ShowS
$cshowsPrec :: Int -> ErrorBallot -> ShowS
Show,(forall x. ErrorBallot -> Rep ErrorBallot x)
-> (forall x. Rep ErrorBallot x -> ErrorBallot)
-> Generic ErrorBallot
forall x. Rep ErrorBallot x -> ErrorBallot
forall x. ErrorBallot -> Rep ErrorBallot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ErrorBallot x -> ErrorBallot
$cfrom :: forall x. ErrorBallot -> Rep ErrorBallot x
Generic,ErrorBallot -> ()
(ErrorBallot -> ()) -> NFData ErrorBallot
forall a. (a -> ()) -> NFData a
rnf :: ErrorBallot -> ()
$crnf :: ErrorBallot -> ()
NFData)

-- ** Hashing

-- | @('ballotStatement' ballot)@
-- returns the encrypted material to be signed:
-- all the 'encryption_nonce's and 'encryption_vault's of the given 'ballot_answers'.
ballotStatement :: CryptoParams crypto c => [Answer crypto v c] -> [G crypto c]
ballotStatement :: [Answer crypto v c] -> [G crypto c]
ballotStatement =
	(Answer crypto v c -> [G crypto c])
-> [Answer crypto v c] -> [G crypto c]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Answer crypto v c -> [G crypto c])
 -> [Answer crypto v c] -> [G crypto c])
-> (Answer crypto v c -> [G crypto c])
-> [Answer crypto v c]
-> [G crypto c]
forall a b. (a -> b) -> a -> b
$ \Answer{[(Encryption crypto v c, DisjProof crypto v c)]
DisjProof crypto v c
answer_sumProof :: DisjProof crypto v c
answer_opinions :: [(Encryption crypto v c, DisjProof crypto v c)]
answer_sumProof :: forall crypto v c. Answer crypto v c -> DisjProof crypto v c
answer_opinions :: forall crypto v c.
Answer crypto v c
-> [(Encryption crypto v c, DisjProof crypto v c)]
..} ->
		(((Encryption crypto v c, DisjProof crypto v c) -> [G crypto c])
-> [(Encryption crypto v c, DisjProof crypto v c)] -> [G crypto c]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
`foldMap` [(Encryption crypto v c, DisjProof crypto v c)]
answer_opinions) (((Encryption crypto v c, DisjProof crypto v c) -> [G crypto c])
 -> [G crypto c])
-> ((Encryption crypto v c, DisjProof crypto v c) -> [G crypto c])
-> [G crypto c]
forall a b. (a -> b) -> a -> b
$ \(Encryption{G crypto c
encryption_vault :: forall crypto k (v :: k) c. Encryption crypto v c -> G crypto c
encryption_nonce :: forall crypto k (v :: k) c. Encryption crypto v c -> G crypto c
encryption_vault :: G crypto c
encryption_nonce :: G crypto c
..}, DisjProof crypto v c
_proof) ->
			[G crypto c
encryption_nonce, G crypto c
encryption_vault]

-- | @('ballotCommitments' voterZKP commitment)@
ballotCommitments ::
 CryptoParams crypto c =>
 ToNatural (G crypto c) =>
 ZKP -> Commitment crypto c -> BS.ByteString
ballotCommitments :: ZKP -> Commitment crypto c -> ByteString
ballotCommitments (ZKP ByteString
voterZKP) Commitment crypto c
commitment =
	ByteString
"sig|"ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>ByteString
voterZKPByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>ByteString
"|" -- NOTE: this is actually part of the statement
	 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Commitment crypto c -> ByteString
forall n. ToNatural n => n -> ByteString
bytesNat Commitment crypto c
commitmentByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>ByteString
"|"