{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-} -- for Reifies constraints in instances
module Voting.Protocol.Cryptography where

import Control.DeepSeq (NFData)
import Control.Monad (Monad(..), join, replicateM)
import Control.Monad.Trans.Except (ExceptT(..), throwE)
import Data.Aeson (ToJSON(..), FromJSON(..), (.:), (.=))
import Data.Bits
import Data.Bool
import Data.Eq (Eq(..))
import Data.Function (($), (.))
import Data.Functor (Functor, (<$>))
import Data.Maybe (Maybe(..), fromJust)
import Data.Ord (Ord(..))
import Data.Proxy (Proxy(..))
import Data.Reflection (Reifies(..))
import Data.Semigroup (Semigroup(..))
import Data.String (IsString(..))
import Data.Text (Text)
import GHC.Generics (Generic)
import GHC.Natural (minusNaturalMaybe)
import Numeric.Natural (Natural)
import Prelude (Bounded(..), fromIntegral)
import System.Random (RandomGen)
import Text.Show (Show(..))
import qualified Control.Monad.Trans.State.Strict as S
import qualified Crypto.Hash as Crypto
import qualified Data.Aeson as JSON
import qualified Data.ByteArray as ByteArray
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as BS64
import qualified Data.List as List
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TLB
import qualified Data.Text.Lazy.Builder.Int as TLB
import qualified System.Random as Random

import Voting.Protocol.Utils
import Voting.Protocol.Arithmetic
import Voting.Protocol.Version

-- * Type 'PublicKey'
type PublicKey = G
-- * Type 'SecretKey'
type SecretKey = E

-- * Type 'Hash'
newtype Hash crypto c = Hash (E crypto c)
 deriving newtype (Hash crypto c -> Hash crypto c -> Bool
(Hash crypto c -> Hash crypto c -> Bool)
-> (Hash crypto c -> Hash crypto c -> Bool) -> Eq (Hash crypto c)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall crypto c. Hash crypto c -> Hash crypto c -> Bool
/= :: Hash crypto c -> Hash crypto c -> Bool
$c/= :: forall crypto c. Hash crypto c -> Hash crypto c -> Bool
== :: Hash crypto c -> Hash crypto c -> Bool
$c== :: forall crypto c. Hash crypto c -> Hash crypto c -> Bool
Eq,Eq (Hash crypto c)
Eq (Hash crypto c)
-> (Hash crypto c -> Hash crypto c -> Ordering)
-> (Hash crypto c -> Hash crypto c -> Bool)
-> (Hash crypto c -> Hash crypto c -> Bool)
-> (Hash crypto c -> Hash crypto c -> Bool)
-> (Hash crypto c -> Hash crypto c -> Bool)
-> (Hash crypto c -> Hash crypto c -> Hash crypto c)
-> (Hash crypto c -> Hash crypto c -> Hash crypto c)
-> Ord (Hash crypto c)
Hash crypto c -> Hash crypto c -> Bool
Hash crypto c -> Hash crypto c -> Ordering
Hash crypto c -> Hash crypto c -> Hash crypto c
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall crypto c. Eq (Hash crypto c)
forall crypto c. Hash crypto c -> Hash crypto c -> Bool
forall crypto c. Hash crypto c -> Hash crypto c -> Ordering
forall crypto c. Hash crypto c -> Hash crypto c -> Hash crypto c
min :: Hash crypto c -> Hash crypto c -> Hash crypto c
$cmin :: forall crypto c. Hash crypto c -> Hash crypto c -> Hash crypto c
max :: Hash crypto c -> Hash crypto c -> Hash crypto c
$cmax :: forall crypto c. Hash crypto c -> Hash crypto c -> Hash crypto c
>= :: Hash crypto c -> Hash crypto c -> Bool
$c>= :: forall crypto c. Hash crypto c -> Hash crypto c -> Bool
> :: Hash crypto c -> Hash crypto c -> Bool
$c> :: forall crypto c. Hash crypto c -> Hash crypto c -> Bool
<= :: Hash crypto c -> Hash crypto c -> Bool
$c<= :: forall crypto c. Hash crypto c -> Hash crypto c -> Bool
< :: Hash crypto c -> Hash crypto c -> Bool
$c< :: forall crypto c. Hash crypto c -> Hash crypto c -> Bool
compare :: Hash crypto c -> Hash crypto c -> Ordering
$ccompare :: forall crypto c. Hash crypto c -> Hash crypto c -> Ordering
$cp1Ord :: forall crypto c. Eq (Hash crypto c)
Ord,Int -> Hash crypto c -> ShowS
[Hash crypto c] -> ShowS
Hash crypto c -> String
(Int -> Hash crypto c -> ShowS)
-> (Hash crypto c -> String)
-> ([Hash crypto c] -> ShowS)
-> Show (Hash crypto c)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall crypto c. Int -> Hash crypto c -> ShowS
forall crypto c. [Hash crypto c] -> ShowS
forall crypto c. Hash crypto c -> String
showList :: [Hash crypto c] -> ShowS
$cshowList :: forall crypto c. [Hash crypto c] -> ShowS
show :: Hash crypto c -> String
$cshow :: forall crypto c. Hash crypto c -> String
showsPrec :: Int -> Hash crypto c -> ShowS
$cshowsPrec :: forall crypto c. Int -> Hash crypto c -> ShowS
Show,Hash crypto c -> ()
(Hash crypto c -> ()) -> NFData (Hash crypto c)
forall a. (a -> ()) -> NFData a
forall crypto c. Hash crypto c -> ()
rnf :: Hash crypto c -> ()
$crnf :: forall crypto c. Hash crypto c -> ()
NFData)

-- | @('hash' bs gs)@ returns as a number in 'E'
-- the 'Crypto.SHA256' hash of the given 'BS.ByteString' 'bs'
-- prefixing the decimal representation of given subgroup elements 'gs',
-- with a comma (",") intercalated between them.
--
-- NOTE: to avoid any collision when the 'hash' function is used in different contexts,
-- a message 'gs' is actually prefixed by a 'bs' indicating the context.
--
-- Used by 'proveEncryption' and 'verifyEncryption',
-- where the 'bs' usually contains the 'statement' to be proven,
-- and the 'gs' contains the 'commitments'.
hash :: CryptoParams crypto c => BS.ByteString -> [G crypto c] -> E crypto c
hash :: ByteString -> [G crypto c] -> E crypto c
hash ByteString
bs [G crypto c]
gs = do
	let s :: ByteString
s = ByteString
bs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> [ByteString] -> ByteString
BS.intercalate (String -> ByteString
forall a. IsString a => String -> a
fromString String
",") (G crypto c -> ByteString
forall n. ToNatural n => n -> ByteString
bytesNat (G crypto c -> ByteString) -> [G crypto c] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [G crypto c]
gs)
	let h :: Digest SHA256
h = SHA256 -> ByteString -> Digest SHA256
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
Crypto.hashWith SHA256
Crypto.SHA256 ByteString
s
	Natural -> E crypto c
forall a. FromNatural a => Natural -> a
fromNatural (Natural -> E crypto c) -> Natural -> E crypto c
forall a b. (a -> b) -> a -> b
$
		ByteString -> Natural
decodeBigEndian (ByteString -> Natural) -> ByteString -> Natural
forall a b. (a -> b) -> a -> b
$ Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert Digest SHA256
h

-- | @('decodeBigEndian' bs)@ interpret @bs@ as big-endian number.
decodeBigEndian :: BS.ByteString -> Natural
decodeBigEndian :: ByteString -> Natural
decodeBigEndian =
	(Natural -> Word8 -> Natural) -> Natural -> ByteString -> Natural
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl'
	 (\Natural
acc Word8
b -> Natural
accNatural -> Int -> Natural
forall a. Bits a => a -> Int -> a
`shiftL`Int
8 Natural -> Natural -> Natural
forall a. Additive a => a -> a -> a
+ Word8 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b)
	 (Natural
0::Natural)

-- ** Type 'Base64SHA256'
newtype Base64SHA256 = Base64SHA256 Text
 deriving (Base64SHA256 -> Base64SHA256 -> Bool
(Base64SHA256 -> Base64SHA256 -> Bool)
-> (Base64SHA256 -> Base64SHA256 -> Bool) -> Eq Base64SHA256
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Base64SHA256 -> Base64SHA256 -> Bool
$c/= :: Base64SHA256 -> Base64SHA256 -> Bool
== :: Base64SHA256 -> Base64SHA256 -> Bool
$c== :: Base64SHA256 -> Base64SHA256 -> Bool
Eq,Eq Base64SHA256
Eq Base64SHA256
-> (Base64SHA256 -> Base64SHA256 -> Ordering)
-> (Base64SHA256 -> Base64SHA256 -> Bool)
-> (Base64SHA256 -> Base64SHA256 -> Bool)
-> (Base64SHA256 -> Base64SHA256 -> Bool)
-> (Base64SHA256 -> Base64SHA256 -> Bool)
-> (Base64SHA256 -> Base64SHA256 -> Base64SHA256)
-> (Base64SHA256 -> Base64SHA256 -> Base64SHA256)
-> Ord Base64SHA256
Base64SHA256 -> Base64SHA256 -> Bool
Base64SHA256 -> Base64SHA256 -> Ordering
Base64SHA256 -> Base64SHA256 -> Base64SHA256
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Base64SHA256 -> Base64SHA256 -> Base64SHA256
$cmin :: Base64SHA256 -> Base64SHA256 -> Base64SHA256
max :: Base64SHA256 -> Base64SHA256 -> Base64SHA256
$cmax :: Base64SHA256 -> Base64SHA256 -> Base64SHA256
>= :: Base64SHA256 -> Base64SHA256 -> Bool
$c>= :: Base64SHA256 -> Base64SHA256 -> Bool
> :: Base64SHA256 -> Base64SHA256 -> Bool
$c> :: Base64SHA256 -> Base64SHA256 -> Bool
<= :: Base64SHA256 -> Base64SHA256 -> Bool
$c<= :: Base64SHA256 -> Base64SHA256 -> Bool
< :: Base64SHA256 -> Base64SHA256 -> Bool
$c< :: Base64SHA256 -> Base64SHA256 -> Bool
compare :: Base64SHA256 -> Base64SHA256 -> Ordering
$ccompare :: Base64SHA256 -> Base64SHA256 -> Ordering
$cp1Ord :: Eq Base64SHA256
Ord,Int -> Base64SHA256 -> ShowS
[Base64SHA256] -> ShowS
Base64SHA256 -> String
(Int -> Base64SHA256 -> ShowS)
-> (Base64SHA256 -> String)
-> ([Base64SHA256] -> ShowS)
-> Show Base64SHA256
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Base64SHA256] -> ShowS
$cshowList :: [Base64SHA256] -> ShowS
show :: Base64SHA256 -> String
$cshow :: Base64SHA256 -> String
showsPrec :: Int -> Base64SHA256 -> ShowS
$cshowsPrec :: Int -> Base64SHA256 -> ShowS
Show,(forall x. Base64SHA256 -> Rep Base64SHA256 x)
-> (forall x. Rep Base64SHA256 x -> Base64SHA256)
-> Generic Base64SHA256
forall x. Rep Base64SHA256 x -> Base64SHA256
forall x. Base64SHA256 -> Rep Base64SHA256 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Base64SHA256 x -> Base64SHA256
$cfrom :: forall x. Base64SHA256 -> Rep Base64SHA256 x
Generic)
 deriving anyclass ([Base64SHA256] -> Encoding
[Base64SHA256] -> Value
Base64SHA256 -> Encoding
Base64SHA256 -> Value
(Base64SHA256 -> Value)
-> (Base64SHA256 -> Encoding)
-> ([Base64SHA256] -> Value)
-> ([Base64SHA256] -> Encoding)
-> ToJSON Base64SHA256
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Base64SHA256] -> Encoding
$ctoEncodingList :: [Base64SHA256] -> Encoding
toJSONList :: [Base64SHA256] -> Value
$ctoJSONList :: [Base64SHA256] -> Value
toEncoding :: Base64SHA256 -> Encoding
$ctoEncoding :: Base64SHA256 -> Encoding
toJSON :: Base64SHA256 -> Value
$ctoJSON :: Base64SHA256 -> Value
ToJSON,Value -> Parser [Base64SHA256]
Value -> Parser Base64SHA256
(Value -> Parser Base64SHA256)
-> (Value -> Parser [Base64SHA256]) -> FromJSON Base64SHA256
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Base64SHA256]
$cparseJSONList :: Value -> Parser [Base64SHA256]
parseJSON :: Value -> Parser Base64SHA256
$cparseJSON :: Value -> Parser Base64SHA256
FromJSON)
 deriving newtype Base64SHA256 -> ()
(Base64SHA256 -> ()) -> NFData Base64SHA256
forall a. (a -> ()) -> NFData a
rnf :: Base64SHA256 -> ()
$crnf :: Base64SHA256 -> ()
NFData

-- | @('base64SHA256' bs)@ returns the 'Crypto.SHA256' hash
-- of the given 'BS.ByteString' 'bs',
-- as a 'Text' escaped in @base64@ encoding
-- (<https://tools.ietf.org/html/rfc4648 RFC 4648>).
base64SHA256 :: BS.ByteString -> Base64SHA256
base64SHA256 :: ByteString -> Base64SHA256
base64SHA256 ByteString
bs =
	let h :: Digest SHA256
h = SHA256 -> ByteString -> Digest SHA256
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
Crypto.hashWith SHA256
Crypto.SHA256 ByteString
bs in
	Text -> Base64SHA256
Base64SHA256 (Text -> Base64SHA256) -> Text -> Base64SHA256
forall a b. (a -> b) -> a -> b
$
		(Char -> Bool) -> Text -> Text
Text.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'=') (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ -- NOTE: no padding.
		ByteString -> Text
Text.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS64.encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert Digest SHA256
h

-- ** Type 'HexSHA256'
newtype HexSHA256 = HexSHA256 Text
 deriving (HexSHA256 -> HexSHA256 -> Bool
(HexSHA256 -> HexSHA256 -> Bool)
-> (HexSHA256 -> HexSHA256 -> Bool) -> Eq HexSHA256
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HexSHA256 -> HexSHA256 -> Bool
$c/= :: HexSHA256 -> HexSHA256 -> Bool
== :: HexSHA256 -> HexSHA256 -> Bool
$c== :: HexSHA256 -> HexSHA256 -> Bool
Eq,Eq HexSHA256
Eq HexSHA256
-> (HexSHA256 -> HexSHA256 -> Ordering)
-> (HexSHA256 -> HexSHA256 -> Bool)
-> (HexSHA256 -> HexSHA256 -> Bool)
-> (HexSHA256 -> HexSHA256 -> Bool)
-> (HexSHA256 -> HexSHA256 -> Bool)
-> (HexSHA256 -> HexSHA256 -> HexSHA256)
-> (HexSHA256 -> HexSHA256 -> HexSHA256)
-> Ord HexSHA256
HexSHA256 -> HexSHA256 -> Bool
HexSHA256 -> HexSHA256 -> Ordering
HexSHA256 -> HexSHA256 -> HexSHA256
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HexSHA256 -> HexSHA256 -> HexSHA256
$cmin :: HexSHA256 -> HexSHA256 -> HexSHA256
max :: HexSHA256 -> HexSHA256 -> HexSHA256
$cmax :: HexSHA256 -> HexSHA256 -> HexSHA256
>= :: HexSHA256 -> HexSHA256 -> Bool
$c>= :: HexSHA256 -> HexSHA256 -> Bool
> :: HexSHA256 -> HexSHA256 -> Bool
$c> :: HexSHA256 -> HexSHA256 -> Bool
<= :: HexSHA256 -> HexSHA256 -> Bool
$c<= :: HexSHA256 -> HexSHA256 -> Bool
< :: HexSHA256 -> HexSHA256 -> Bool
$c< :: HexSHA256 -> HexSHA256 -> Bool
compare :: HexSHA256 -> HexSHA256 -> Ordering
$ccompare :: HexSHA256 -> HexSHA256 -> Ordering
$cp1Ord :: Eq HexSHA256
Ord,Int -> HexSHA256 -> ShowS
[HexSHA256] -> ShowS
HexSHA256 -> String
(Int -> HexSHA256 -> ShowS)
-> (HexSHA256 -> String)
-> ([HexSHA256] -> ShowS)
-> Show HexSHA256
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HexSHA256] -> ShowS
$cshowList :: [HexSHA256] -> ShowS
show :: HexSHA256 -> String
$cshow :: HexSHA256 -> String
showsPrec :: Int -> HexSHA256 -> ShowS
$cshowsPrec :: Int -> HexSHA256 -> ShowS
Show,(forall x. HexSHA256 -> Rep HexSHA256 x)
-> (forall x. Rep HexSHA256 x -> HexSHA256) -> Generic HexSHA256
forall x. Rep HexSHA256 x -> HexSHA256
forall x. HexSHA256 -> Rep HexSHA256 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HexSHA256 x -> HexSHA256
$cfrom :: forall x. HexSHA256 -> Rep HexSHA256 x
Generic)
 deriving anyclass ([HexSHA256] -> Encoding
[HexSHA256] -> Value
HexSHA256 -> Encoding
HexSHA256 -> Value
(HexSHA256 -> Value)
-> (HexSHA256 -> Encoding)
-> ([HexSHA256] -> Value)
-> ([HexSHA256] -> Encoding)
-> ToJSON HexSHA256
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [HexSHA256] -> Encoding
$ctoEncodingList :: [HexSHA256] -> Encoding
toJSONList :: [HexSHA256] -> Value
$ctoJSONList :: [HexSHA256] -> Value
toEncoding :: HexSHA256 -> Encoding
$ctoEncoding :: HexSHA256 -> Encoding
toJSON :: HexSHA256 -> Value
$ctoJSON :: HexSHA256 -> Value
ToJSON,Value -> Parser [HexSHA256]
Value -> Parser HexSHA256
(Value -> Parser HexSHA256)
-> (Value -> Parser [HexSHA256]) -> FromJSON HexSHA256
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [HexSHA256]
$cparseJSONList :: Value -> Parser [HexSHA256]
parseJSON :: Value -> Parser HexSHA256
$cparseJSON :: Value -> Parser HexSHA256
FromJSON)
 deriving newtype HexSHA256 -> ()
(HexSHA256 -> ()) -> NFData HexSHA256
forall a. (a -> ()) -> NFData a
rnf :: HexSHA256 -> ()
$crnf :: HexSHA256 -> ()
NFData
-- | @('hexSHA256' bs)@ returns the 'Crypto.SHA256' hash
-- of the given 'BS.ByteString' 'bs', escaped in hexadecimal
-- into a 'Text' of 32 lowercase characters.
--
-- Used (in retro-dependencies of this library) to hash
-- the 'PublicKey' of a voter or a trustee.
hexSHA256 :: BS.ByteString -> Text
hexSHA256 :: ByteString -> Text
hexSHA256 ByteString
bs =
	let h :: Digest SHA256
h = SHA256 -> ByteString -> Digest SHA256
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
Crypto.hashWith SHA256
Crypto.SHA256 ByteString
bs in
	let n :: Natural
n = ByteString -> Natural
decodeBigEndian (ByteString -> Natural) -> ByteString -> Natural
forall a b. (a -> b) -> a -> b
$ Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
ByteArray.convert Digest SHA256
h in
	-- NOTE: always set the 256 bit then remove it
	-- to always have leading zeros,
	-- and thus always 64 characters wide hashes.
	Text -> Text
TL.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
	Text -> Text
TL.tail (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> Text
TLB.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ Natural -> Builder
forall a. Integral a => a -> Builder
TLB.hexadecimal (Natural -> Builder) -> Natural -> Builder
forall a b. (a -> b) -> a -> b
$
	Natural -> Int -> Natural
forall a. Bits a => a -> Int -> a
setBit Natural
n Int
256

-- * Random

-- | @('randomR' i)@ returns a random integer in @[0..i-1]@.
randomR ::
 Monad m =>
 Random.RandomGen r =>
 Random.Random i =>
 Ring i =>
 i -> S.StateT r m i
randomR :: i -> StateT r m i
randomR i
i = (r -> m (i, r)) -> StateT r m i
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
S.StateT ((r -> m (i, r)) -> StateT r m i)
-> (r -> m (i, r)) -> StateT r m i
forall a b. (a -> b) -> a -> b
$ (i, r) -> m (i, r)
forall (m :: * -> *) a. Monad m => a -> m a
return ((i, r) -> m (i, r)) -> (r -> (i, r)) -> r -> m (i, r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i, i) -> r -> (i, r)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
Random.randomR (i
forall a. Additive a => a
zero, i
ii -> i -> i
forall a. Ring a => a -> a -> a
-i
forall a. Semiring a => a
one)

-- | @('random')@ returns a random integer
-- in the range determined by its type.
random ::
 Monad m =>
 Random.RandomGen r =>
 Random.Random i =>
 Bounded i =>
 S.StateT r m i
random :: StateT r m i
random = (r -> m (i, r)) -> StateT r m i
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
S.StateT ((r -> m (i, r)) -> StateT r m i)
-> (r -> m (i, r)) -> StateT r m i
forall a b. (a -> b) -> a -> b
$ (i, r) -> m (i, r)
forall (m :: * -> *) a. Monad m => a -> m a
return ((i, r) -> m (i, r)) -> (r -> (i, r)) -> r -> m (i, r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> (i, r)
forall a g. (Random a, RandomGen g) => g -> (a, g)
Random.random

-- * Type 'Encryption'
-- | ElGamal-like encryption.
-- Its security relies on the /Discrete Logarithm problem/.
--
-- Because ('groupGen' '^'encNonce '^'secKey '==' 'groupGen' '^'secKey '^'encNonce),
-- knowing @secKey@, one can divide 'encryption_vault' by @('encryption_nonce' '^'secKey)@
-- to decipher @('groupGen' '^'clear)@, then the @clear@ text must be small to be decryptable,
-- because it is encrypted as a power of 'groupGen' (hence the "-like" in "ElGamal-like")
-- to enable the additive homomorphism.
--
-- NOTE: Since @('encryption_vault' '*' 'encryption_nonce' '==' 'encryption_nonce' '^' (secKey '+' clear))@,
-- then: @(logBase 'encryption_nonce' ('encryption_vault' '*' 'encryption_nonce') '==' secKey '+' clear)@.
data Encryption crypto v c = Encryption
 { Encryption crypto v c -> G crypto c
encryption_nonce :: !(G crypto c)
   -- ^ Public part of the randomness 'encNonce' used to 'encrypt' the 'clear' text,
   -- equal to @('groupGen' '^'encNonce)@
 , Encryption crypto v c -> G crypto c
encryption_vault :: !(G crypto c)
   -- ^ Encrypted 'clear' text,
   -- equal to @('pubKey' '^'encNone '*' 'groupGen' '^'clear)@
 } deriving ((forall x. Encryption crypto v c -> Rep (Encryption crypto v c) x)
-> (forall x.
    Rep (Encryption crypto v c) x -> Encryption crypto v c)
-> Generic (Encryption crypto v c)
forall x. Rep (Encryption crypto v c) x -> Encryption crypto v c
forall x. Encryption crypto v c -> Rep (Encryption crypto v c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto k (v :: k) c x.
Rep (Encryption crypto v c) x -> Encryption crypto v c
forall crypto k (v :: k) c x.
Encryption crypto v c -> Rep (Encryption crypto v c) x
$cto :: forall crypto k (v :: k) c x.
Rep (Encryption crypto v c) x -> Encryption crypto v c
$cfrom :: forall crypto k (v :: k) c x.
Encryption crypto v c -> Rep (Encryption crypto v c) x
Generic)
deriving instance Eq (G crypto c) => Eq (Encryption crypto v c)
deriving instance (Show (G crypto c), Show (G crypto c)) => Show (Encryption crypto v c)
deriving instance NFData (G crypto c) => NFData (Encryption crypto v c)
instance
 ( Reifies v Version
 , CryptoParams crypto c
 ) => ToJSON (Encryption crypto v c) where
	toJSON :: Encryption crypto v c -> Value
toJSON Encryption{G crypto c
encryption_vault :: G crypto c
encryption_nonce :: 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
..} =
		[Pair] -> Value
JSON.object
		 [ Text
"alpha" Text -> G crypto c -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= G crypto c
encryption_nonce
		 , Text
"beta"  Text -> G crypto c -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= G crypto c
encryption_vault
		 ]
	toEncoding :: Encryption crypto v c -> Encoding
toEncoding Encryption{G crypto c
encryption_vault :: G crypto c
encryption_nonce :: 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
..} =
		Series -> Encoding
JSON.pairs
		 (  Text
"alpha" Text -> G crypto c -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= G crypto c
encryption_nonce
		 Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
"beta"  Text -> G crypto c -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= G crypto c
encryption_vault
		 )
instance
 ( Reifies v Version
 , CryptoParams crypto c
 ) => FromJSON (Encryption crypto v c) where
	parseJSON :: Value -> Parser (Encryption crypto v c)
parseJSON = String
-> (Object -> Parser (Encryption crypto v c))
-> Value
-> Parser (Encryption crypto v c)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Encryption" ((Object -> Parser (Encryption crypto v c))
 -> Value -> Parser (Encryption crypto v c))
-> (Object -> Parser (Encryption crypto v c))
-> Value
-> Parser (Encryption crypto v c)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
		G crypto c
encryption_nonce <- Object
o Object -> Text -> Parser (G crypto c)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"alpha"
		G crypto c
encryption_vault <- Object
o Object -> Text -> Parser (G crypto c)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"beta"
		Encryption crypto v c -> Parser (Encryption crypto v c)
forall (m :: * -> *) a. Monad m => a -> m a
return Encryption :: forall k crypto (v :: k) c.
G crypto c -> G crypto c -> Encryption crypto v c
Encryption{G crypto c
encryption_vault :: G crypto c
encryption_nonce :: G crypto c
encryption_vault :: G crypto c
encryption_nonce :: G crypto c
..}

-- | Additive homomorphism.
-- Using the fact that: @'groupGen' '^'x '*' 'groupGen' '^'y '==' 'groupGen' '^'(x'+'y)@.
instance CryptoParams crypto c => Additive (Encryption crypto v c) where
	zero :: Encryption crypto v c
zero = G crypto c -> G crypto c -> Encryption crypto v c
forall k crypto (v :: k) c.
G crypto c -> G crypto c -> Encryption crypto v c
Encryption G crypto c
forall a. Semiring a => a
one G crypto c
forall a. Semiring a => a
one
	Encryption crypto v c
x+ :: Encryption crypto v c
-> Encryption crypto v c -> Encryption crypto v c
+Encryption crypto v c
y = G crypto c -> G crypto c -> Encryption crypto v c
forall k crypto (v :: k) c.
G crypto c -> G crypto c -> Encryption crypto v c
Encryption
	 (Encryption crypto v c -> G crypto c
forall crypto k (v :: k) c. Encryption crypto v c -> G crypto c
encryption_nonce Encryption crypto v c
x G crypto c -> G crypto c -> G crypto c
forall a. Semiring a => a -> a -> a
* Encryption crypto v c -> G crypto c
forall crypto k (v :: k) c. Encryption crypto v c -> G crypto c
encryption_nonce Encryption crypto v c
y)
	 (Encryption crypto v c -> G crypto c
forall crypto k (v :: k) c. Encryption crypto v c -> G crypto c
encryption_vault Encryption crypto v c
x G crypto c -> G crypto c -> G crypto c
forall a. Semiring a => a -> a -> a
* Encryption crypto v c -> G crypto c
forall crypto k (v :: k) c. Encryption crypto v c -> G crypto c
encryption_vault Encryption crypto v c
y)

-- *** Type 'EncryptionNonce'
type EncryptionNonce = E

-- | @('encrypt' pubKey clear)@ returns an ElGamal-like 'Encryption'.
--
-- WARNING: the secret encryption nonce (@encNonce@)
-- is returned alongside the 'Encryption'
-- in order to 'prove' the validity of the encrypted 'clear' text in 'proveEncryption',
-- but this secret @encNonce@ MUST be forgotten after that,
-- as it may be used to decipher the 'Encryption'
-- without the 'SecretKey' associated with 'pubKey'.
encrypt ::
 Reifies v Version =>
 CryptoParams crypto c =>
 Monad m => RandomGen r =>
 PublicKey crypto c -> E crypto c ->
 S.StateT r m (EncryptionNonce crypto c, Encryption crypto v c)
encrypt :: PublicKey crypto c
-> E crypto c -> StateT r m (E crypto c, Encryption crypto v c)
encrypt PublicKey crypto c
pubKey E crypto c
clear = do
	E crypto c
encNonce <- StateT r m (E crypto c)
forall (m :: * -> *) r i.
(Monad m, RandomGen r, Random i, Bounded i) =>
StateT r m i
random
	-- NOTE: preserve the 'encNonce' for 'prove' in 'proveEncryption'.
	(E crypto c, Encryption crypto v c)
-> StateT r m (E crypto c, Encryption crypto v c)
forall (m :: * -> *) a. Monad m => a -> m a
return ((E crypto c, Encryption crypto v c)
 -> StateT r m (E crypto c, Encryption crypto v c))
-> (E crypto c, Encryption crypto v c)
-> StateT r m (E crypto c, Encryption crypto v c)
forall a b. (a -> b) -> a -> b
$ (E crypto c
encNonce,)
		Encryption :: forall k crypto (v :: k) c.
G crypto c -> G crypto c -> Encryption crypto v c
Encryption
		 { encryption_nonce :: PublicKey crypto c
encryption_nonce = PublicKey crypto c
forall crypto c. CryptoParams crypto c => G crypto c
groupGenPublicKey crypto c -> E crypto c -> PublicKey crypto c
forall crypto c.
(Reifies c crypto, Semiring (G crypto c)) =>
G crypto c -> E crypto c -> G crypto c
^E crypto c
encNonce
		 , encryption_vault :: PublicKey crypto c
encryption_vault = PublicKey crypto c
pubKey  PublicKey crypto c -> E crypto c -> PublicKey crypto c
forall crypto c.
(Reifies c crypto, Semiring (G crypto c)) =>
G crypto c -> E crypto c -> G crypto c
^E crypto c
encNonce PublicKey crypto c -> PublicKey crypto c -> PublicKey crypto c
forall a. Semiring a => a -> a -> a
* PublicKey crypto c
forall crypto c. CryptoParams crypto c => G crypto c
groupGenPublicKey crypto c -> E crypto c -> PublicKey crypto c
forall crypto c.
(Reifies c crypto, Semiring (G crypto c)) =>
G crypto c -> E crypto c -> G crypto c
^E crypto c
clear
		 }

-- * Type 'Proof'
-- | Non-Interactive Zero-Knowledge 'Proof'
-- of knowledge of a discrete logarithm:
-- @(secret == logBase base (base^secret))@.
data Proof crypto v c = Proof
 { Proof crypto v c -> Challenge crypto c
proof_challenge :: !(Challenge crypto c)
   -- ^ 'Challenge' sent by the verifier to the prover
   -- to ensure that the prover really has knowledge
   -- of the secret and is not replaying.
   -- Actually, 'proof_challenge' is not sent to the prover,
   -- but derived from the prover's 'Commitment's and statements
   -- with a collision resistant 'hash'.
   -- Hence the prover cannot chose the 'proof_challenge' to his/her liking.
 , Proof crypto v c -> E crypto c
proof_response :: !(E crypto c)
   -- ^ A discrete logarithm sent by the prover to the verifier,
   -- as a response to 'proof_challenge'.
   --
   -- If the verifier observes that @('proof_challenge' '==' 'hash' statement [commitment])@, where:
   --
   -- * @statement@ is a serialization of a tag, @base@ and @basePowSec@,
   -- * @commitment '==' 'commit' proof base basePowSec '=='
   --   base '^' 'proof_response' '*' basePowSec '^' 'proof_challenge'@,
   -- * and @basePowSec '==' base'^'sec@,
   --
   -- then, with overwhelming probability (due to the 'hash' function),
   -- the prover was not able to choose 'proof_challenge'
   -- yet was able to compute a 'proof_response' such that
   -- (@commitment '==' base '^' 'proof_response' '*' basePowSec '^' 'proof_challenge'@),
   -- that is to say: @('proof_response' '==' logBase base 'commitment' '-' sec '*' 'proof_challenge')@,
   -- therefore the prover knows 'sec'.
   --
   -- The prover choses 'commitment' to be a random power of @base@,
   -- to ensure that each 'prove' does not reveal any information
   -- about its secret.
 } deriving (Proof crypto v c -> Proof crypto v c -> Bool
(Proof crypto v c -> Proof crypto v c -> Bool)
-> (Proof crypto v c -> Proof crypto v c -> Bool)
-> Eq (Proof crypto v c)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall crypto k (v :: k) c.
Proof crypto v c -> Proof crypto v c -> Bool
/= :: Proof crypto v c -> Proof crypto v c -> Bool
$c/= :: forall crypto k (v :: k) c.
Proof crypto v c -> Proof crypto v c -> Bool
== :: Proof crypto v c -> Proof crypto v c -> Bool
$c== :: forall crypto k (v :: k) c.
Proof crypto v c -> Proof crypto v c -> Bool
Eq,Int -> Proof crypto v c -> ShowS
[Proof crypto v c] -> ShowS
Proof crypto v c -> String
(Int -> Proof crypto v c -> ShowS)
-> (Proof crypto v c -> String)
-> ([Proof crypto v c] -> ShowS)
-> Show (Proof crypto v c)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall crypto k (v :: k) c. Int -> Proof crypto v c -> ShowS
forall crypto k (v :: k) c. [Proof crypto v c] -> ShowS
forall crypto k (v :: k) c. Proof crypto v c -> String
showList :: [Proof crypto v c] -> ShowS
$cshowList :: forall crypto k (v :: k) c. [Proof crypto v c] -> ShowS
show :: Proof crypto v c -> String
$cshow :: forall crypto k (v :: k) c. Proof crypto v c -> String
showsPrec :: Int -> Proof crypto v c -> ShowS
$cshowsPrec :: forall crypto k (v :: k) c. Int -> Proof crypto v c -> ShowS
Show,Proof crypto v c -> ()
(Proof crypto v c -> ()) -> NFData (Proof crypto v c)
forall a. (a -> ()) -> NFData a
forall crypto k (v :: k) c. Proof crypto v c -> ()
rnf :: Proof crypto v c -> ()
$crnf :: forall crypto k (v :: k) c. Proof crypto v c -> ()
NFData,(forall x. Proof crypto v c -> Rep (Proof crypto v c) x)
-> (forall x. Rep (Proof crypto v c) x -> Proof crypto v c)
-> Generic (Proof crypto v c)
forall x. Rep (Proof crypto v c) x -> Proof crypto v c
forall x. Proof crypto v c -> Rep (Proof crypto v c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto k (v :: k) c x.
Rep (Proof crypto v c) x -> Proof crypto v c
forall crypto k (v :: k) c x.
Proof crypto v c -> Rep (Proof crypto v c) x
$cto :: forall crypto k (v :: k) c x.
Rep (Proof crypto v c) x -> Proof crypto v c
$cfrom :: forall crypto k (v :: k) c x.
Proof crypto v c -> Rep (Proof crypto v c) x
Generic)
instance Reifies v Version => ToJSON (Proof crypto v c) where
	toJSON :: Proof crypto v c -> Value
toJSON Proof{E crypto c
proof_response :: E crypto c
proof_challenge :: E crypto c
proof_response :: forall crypto k (v :: k) c. Proof crypto v c -> Challenge crypto c
proof_challenge :: forall crypto k (v :: k) c. Proof crypto v c -> Challenge crypto c
..} =
		[Pair] -> Value
JSON.object
		 [ Text
"challenge" Text -> E crypto c -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= E crypto c
proof_challenge
		 , Text
"response"  Text -> E crypto c -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= E crypto c
proof_response
		 ]
	toEncoding :: Proof crypto v c -> Encoding
toEncoding Proof{E crypto c
proof_response :: E crypto c
proof_challenge :: E crypto c
proof_response :: forall crypto k (v :: k) c. Proof crypto v c -> Challenge crypto c
proof_challenge :: forall crypto k (v :: k) c. Proof crypto v c -> Challenge crypto c
..} =
		Series -> Encoding
JSON.pairs
		 (  Text
"challenge" Text -> E crypto c -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= E crypto c
proof_challenge
		 Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
"response"  Text -> E crypto c -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= E crypto c
proof_response
		 )
instance
 ( CryptoParams crypto c
 , Reifies v Version
 ) => FromJSON (Proof crypto v c) where
	parseJSON :: Value -> Parser (Proof crypto v c)
parseJSON = String
-> (Object -> Parser (Proof crypto v c))
-> Value
-> Parser (Proof crypto v c)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Proof" ((Object -> Parser (Proof crypto v c))
 -> Value -> Parser (Proof crypto v c))
-> (Object -> Parser (Proof crypto v c))
-> Value
-> Parser (Proof crypto v c)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
		Challenge crypto c
proof_challenge <- Object
o Object -> Text -> Parser (Challenge crypto c)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"challenge"
		Challenge crypto c
proof_response  <- Object
o Object -> Text -> Parser (Challenge crypto c)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"response"
		Proof crypto v c -> Parser (Proof crypto v c)
forall (m :: * -> *) a. Monad m => a -> m a
return Proof :: forall k crypto (v :: k) c.
Challenge crypto c -> Challenge crypto c -> Proof crypto v c
Proof{Challenge crypto c
proof_response :: Challenge crypto c
proof_challenge :: Challenge crypto c
proof_response :: Challenge crypto c
proof_challenge :: Challenge crypto c
..}

-- ** Type 'ZKP'
-- | Zero-knowledge proof.
--
-- A protocol is /zero-knowledge/ if the verifier
-- learns nothing from the protocol except that the prover
-- knows the secret.
--
-- DOC: Mihir Bellare and Phillip Rogaway. Random oracles are practical:
--      A paradigm for designing efficient protocols. In ACM-CCS’93, 1993.
newtype ZKP = ZKP BS.ByteString

-- ** Type 'Challenge'
type Challenge = E

-- ** Type 'Oracle'
-- An 'Oracle' returns the 'Challenge' of the 'Commitment's
-- by 'hash'ing them (eventually with other 'Commitment's).
--
-- Used in 'prove' it enables a Fiat-Shamir transformation
-- of an /interactive zero-knowledge/ (IZK) proof
-- into a /non-interactive zero-knowledge/ (NIZK) proof.
-- That is to say that the verifier does not have
-- to send a 'Challenge' to the prover.
-- Indeed, the prover now handles the 'Challenge'
-- which becomes a (collision resistant) 'hash'
-- of the prover's commitments (and statements to be a stronger proof).
type Oracle list crypto c = list (Commitment crypto c) -> Challenge crypto c

-- | @('prove' sec commitmentBases oracle)@
-- returns a 'Proof' that @sec@ is known
-- (by proving the knowledge of its discrete logarithm).
--
-- The 'Oracle' is given 'Commitment's equal to the 'commitmentBases'
-- raised to the power of the secret nonce of the 'Proof',
-- as those are the 'Commitment's that the verifier will obtain
-- when composing the 'proof_challenge' and 'proof_response' together
-- (with 'commit').
--
-- WARNING: for 'prove' to be a so-called /strong Fiat-Shamir transformation/ (not a weak):
-- the statement must be included in the 'hash' (along with the commitments).
--
-- NOTE: a 'random' @nonce@ is used to ensure each 'prove'
-- does not reveal any information regarding the secret @sec@,
-- because two 'Proof's using the same 'Commitment'
-- can be used to deduce @sec@ (using the special-soundness).
prove ::
 forall crypto v c list m r.
 Reifies v Version =>
 CryptoParams crypto c =>
 Monad m => RandomGen r => Functor list =>
 E crypto c ->
 list (G crypto c) ->
 Oracle list crypto c ->
 S.StateT r m (Proof crypto v c)
prove :: E crypto c
-> list (G crypto c)
-> Oracle list crypto c
-> StateT r m (Proof crypto v c)
prove E crypto c
sec list (G crypto c)
commitmentBases Oracle list crypto c
oracle = do
	E crypto c
nonce <- StateT r m (E crypto c)
forall (m :: * -> *) r i.
(Monad m, RandomGen r, Random i, Bounded i) =>
StateT r m i
random
	let commitments :: list (G crypto c)
commitments = (G crypto c -> E crypto c -> G crypto c
forall crypto c.
(Reifies c crypto, Semiring (G crypto c)) =>
G crypto c -> E crypto c -> G crypto c
^ E crypto c
nonce) (G crypto c -> G crypto c)
-> list (G crypto c) -> list (G crypto c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> list (G crypto c)
commitmentBases
	let proof_challenge :: E crypto c
proof_challenge = Oracle list crypto c
oracle list (G crypto c)
commitments
	Proof crypto v c -> StateT r m (Proof crypto v c)
forall (m :: * -> *) a. Monad m => a -> m a
return Proof :: forall k crypto (v :: k) c.
Challenge crypto c -> Challenge crypto c -> Proof crypto v c
Proof
	 { E crypto c
proof_challenge :: E crypto c
proof_challenge :: E crypto c
proof_challenge
	 , proof_response :: E crypto c
proof_response = E crypto c
nonce E crypto c -> E crypto c -> E crypto c
`op` (E crypto c
secE crypto c -> E crypto c -> E crypto c
forall a. Semiring a => a -> a -> a
*E crypto c
proof_challenge)
	 }
	where
	-- | See comments in 'commit'.
	op :: E crypto c -> E crypto c -> E crypto c
op =
		if Proxy v -> Version
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
reflect (Proxy v
forall k (t :: k). Proxy t
Proxy @v) Version -> Text -> Bool
`hasVersionTag` Text
versionTagQuicker
		then (-)
		else E crypto c -> E crypto c -> E crypto c
forall a. Additive a => a -> a -> a
(+)

-- | Like 'prove' but quicker. It should replace 'prove' entirely
-- when Helios-C specifications will be fixed.
proveQuicker ::
 Reifies v Version =>
 CryptoParams crypto c =>
 Monad m => RandomGen r => Functor list =>
 E crypto c ->
 list (G crypto c) ->
 Oracle list crypto c ->
 S.StateT r m (Proof crypto v c)
proveQuicker :: E crypto c
-> list (G crypto c)
-> Oracle list crypto c
-> StateT r m (Proof crypto v c)
proveQuicker E crypto c
sec list (G crypto c)
commitmentBases Oracle list crypto c
oracle = do
	E crypto c
nonce <- StateT r m (E crypto c)
forall (m :: * -> *) r i.
(Monad m, RandomGen r, Random i, Bounded i) =>
StateT r m i
random
	let commitments :: list (G crypto c)
commitments = (G crypto c -> E crypto c -> G crypto c
forall crypto c.
(Reifies c crypto, Semiring (G crypto c)) =>
G crypto c -> E crypto c -> G crypto c
^ E crypto c
nonce) (G crypto c -> G crypto c)
-> list (G crypto c) -> list (G crypto c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> list (G crypto c)
commitmentBases
	let proof_challenge :: E crypto c
proof_challenge = Oracle list crypto c
oracle list (G crypto c)
commitments
	Proof crypto v c -> StateT r m (Proof crypto v c)
forall (m :: * -> *) a. Monad m => a -> m a
return Proof :: forall k crypto (v :: k) c.
Challenge crypto c -> Challenge crypto c -> Proof crypto v c
Proof
	 { E crypto c
proof_challenge :: E crypto c
proof_challenge :: E crypto c
proof_challenge
	 , proof_response :: E crypto c
proof_response = E crypto c
nonce E crypto c -> E crypto c -> E crypto c
forall a. Ring a => a -> a -> a
- E crypto c
secE crypto c -> E crypto c -> E crypto c
forall a. Semiring a => a -> a -> a
*E crypto c
proof_challenge
	 }

-- | @('fakeProof')@ returns a 'Proof'
-- whose 'proof_challenge' and 'proof_response' are uniformly chosen at random,
-- instead of @('proof_challenge' '==' 'hash' statement commitments)@
-- and @('proof_response' '==' nonce '+' sec '*' 'proof_challenge')@
-- as a 'Proof' returned by 'prove'.
--
-- Used in 'proveEncryption' to fill the returned 'DisjProof'
-- with fake 'Proof's for all 'Disjunction's but the encrypted one.
fakeProof ::
 CryptoParams crypto c =>
 Monad m => RandomGen r =>
 S.StateT r m (Proof crypto v c)
fakeProof :: StateT r m (Proof crypto v c)
fakeProof = do
	Challenge crypto c
proof_challenge <- StateT r m (Challenge crypto c)
forall (m :: * -> *) r i.
(Monad m, RandomGen r, Random i, Bounded i) =>
StateT r m i
random
	Challenge crypto c
proof_response  <- StateT r m (Challenge crypto c)
forall (m :: * -> *) r i.
(Monad m, RandomGen r, Random i, Bounded i) =>
StateT r m i
random
	Proof crypto v c -> StateT r m (Proof crypto v c)
forall (m :: * -> *) a. Monad m => a -> m a
return Proof :: forall k crypto (v :: k) c.
Challenge crypto c -> Challenge crypto c -> Proof crypto v c
Proof{Challenge crypto c
proof_response :: Challenge crypto c
proof_challenge :: Challenge crypto c
proof_response :: Challenge crypto c
proof_challenge :: Challenge crypto c
..}

-- ** Type 'Commitment'
-- | A commitment from the prover to the verifier.
-- It's a power of 'groupGen' chosen randomly by the prover
-- when making a 'Proof' with 'prove'.
type Commitment = G

-- | @('commit' proof base basePowSec)@ returns a 'Commitment'
-- from the given 'Proof' with the knowledge of the verifier.
commit ::
 forall crypto v c.
 Reifies v Version =>
 CryptoParams crypto c =>
 Proof crypto v c ->
 G crypto c ->
 G crypto c ->
 Commitment crypto c
commit :: Proof crypto v c -> G crypto c -> G crypto c -> G crypto c
commit Proof{E crypto c
proof_response :: E crypto c
proof_challenge :: E crypto c
proof_response :: forall crypto k (v :: k) c. Proof crypto v c -> Challenge crypto c
proof_challenge :: forall crypto k (v :: k) c. Proof crypto v c -> Challenge crypto c
..} G crypto c
base G crypto c
basePowSec =
	(G crypto c
baseG crypto c -> E crypto c -> G crypto c
forall crypto c.
(Reifies c crypto, Semiring (G crypto c)) =>
G crypto c -> E crypto c -> G crypto c
^E crypto c
proof_response) G crypto c -> G crypto c -> G crypto c
`op`
	(G crypto c
basePowSecG crypto c -> E crypto c -> G crypto c
forall crypto c.
(Reifies c crypto, Semiring (G crypto c)) =>
G crypto c -> E crypto c -> G crypto c
^E crypto c
proof_challenge)
	where
	op :: G crypto c -> G crypto c -> G crypto c
op =
		if Proxy v -> Version
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
reflect (Proxy v
forall k (t :: k). Proxy t
Proxy @v) Version -> Text -> Bool
`hasVersionTag` Text
versionTagQuicker
		then G crypto c -> G crypto c -> G crypto c
forall a. Semiring a => a -> a -> a
(*)
		else G crypto c -> G crypto c -> G crypto c
forall a. EuclideanRing a => a -> a -> a
(/)
  -- 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'.
{-# INLINE commit #-}

-- | Like 'commit' but quicker. It chould replace 'commit' entirely
-- when Helios-C specifications will be fixed.
commitQuicker ::
 CryptoParams crypto c =>
 Proof crypto v c ->
 G crypto c ->
 G crypto c ->
 Commitment crypto c
commitQuicker :: Proof crypto v c -> G crypto c -> G crypto c -> G crypto c
commitQuicker Proof{E crypto c
proof_response :: E crypto c
proof_challenge :: E crypto c
proof_response :: forall crypto k (v :: k) c. Proof crypto v c -> Challenge crypto c
proof_challenge :: forall crypto k (v :: k) c. Proof crypto v c -> Challenge crypto c
..} G crypto c
base G crypto c
basePowSec =
	G crypto c
baseG crypto c -> E crypto c -> G crypto c
forall crypto c.
(Reifies c crypto, Semiring (G crypto c)) =>
G crypto c -> E crypto c -> G crypto c
^E crypto c
proof_response G crypto c -> G crypto c -> G crypto c
forall a. Semiring a => a -> a -> a
*
	G crypto c
basePowSecG crypto c -> E crypto c -> G crypto c
forall crypto c.
(Reifies c crypto, Semiring (G crypto c)) =>
G crypto c -> E crypto c -> G crypto c
^E crypto c
proof_challenge

-- * Type 'Disjunction'
-- | A 'Disjunction' is an 'inverse'd @('groupGen' '^'opinion)@
-- it's used in 'proveEncryption' to generate a 'Proof'
-- that an 'encryption_vault' contains a given @('groupGen' '^'opinion)@,
type Disjunction = G

booleanDisjunctions ::
 forall crypto c.
 CryptoParams crypto c =>
 [Disjunction crypto c]
booleanDisjunctions :: [Disjunction crypto c]
booleanDisjunctions = Int -> [Disjunction crypto c] -> [Disjunction crypto c]
forall a. Int -> [a] -> [a]
List.take Int
2 ([Disjunction crypto c] -> [Disjunction crypto c])
-> [Disjunction crypto c] -> [Disjunction crypto c]
forall a b. (a -> b) -> a -> b
$ forall c. CryptoParams crypto c => [G crypto c]
forall crypto c. CryptoParams crypto c => [G crypto c]
groupGenInverses @crypto

intervalDisjunctions ::
 forall crypto c.
 CryptoParams crypto c =>
 Natural -> Natural -> [Disjunction crypto c]
intervalDisjunctions :: Natural -> Natural -> [Disjunction crypto c]
intervalDisjunctions Natural
mini Natural
maxi =
	Natural -> [Disjunction crypto c] -> [Disjunction crypto c]
forall i a. Integral i => i -> [a] -> [a]
List.genericTake (Maybe Natural -> Natural
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Natural -> Natural) -> Maybe Natural -> Natural
forall a b. (a -> b) -> a -> b
$ (Natural -> Natural
forall a. ToNatural a => a -> Natural
nat Natural
maxi Natural -> Natural -> Natural
forall a. Additive a => a -> a -> a
+ Natural
1)Natural -> Natural -> Maybe Natural
`minusNaturalMaybe`Natural -> Natural
forall a. ToNatural a => a -> Natural
nat Natural
mini) ([Disjunction crypto c] -> [Disjunction crypto c])
-> [Disjunction crypto c] -> [Disjunction crypto c]
forall a b. (a -> b) -> a -> b
$
	Natural -> [Disjunction crypto c] -> [Disjunction crypto c]
forall i a. Integral i => i -> [a] -> [a]
List.genericDrop (Natural -> Natural
forall a. ToNatural a => a -> Natural
nat Natural
mini) ([Disjunction crypto c] -> [Disjunction crypto c])
-> [Disjunction crypto c] -> [Disjunction crypto c]
forall a b. (a -> b) -> a -> b
$
	forall c. CryptoParams crypto c => [G crypto c]
forall crypto c. CryptoParams crypto c => [G crypto c]
groupGenInverses @crypto

-- ** Type 'DisjProof'
-- | A list of 'Proof's to prove that the opinion within an 'Encryption'
-- is indexing a 'Disjunction' within a list of them,
-- without revealing which opinion it is.
newtype DisjProof crypto v c = DisjProof [Proof crypto v c]
 deriving (DisjProof crypto v c -> DisjProof crypto v c -> Bool
(DisjProof crypto v c -> DisjProof crypto v c -> Bool)
-> (DisjProof crypto v c -> DisjProof crypto v c -> Bool)
-> Eq (DisjProof crypto v c)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall crypto k (v :: k) c.
DisjProof crypto v c -> DisjProof crypto v c -> Bool
/= :: DisjProof crypto v c -> DisjProof crypto v c -> Bool
$c/= :: forall crypto k (v :: k) c.
DisjProof crypto v c -> DisjProof crypto v c -> Bool
== :: DisjProof crypto v c -> DisjProof crypto v c -> Bool
$c== :: forall crypto k (v :: k) c.
DisjProof crypto v c -> DisjProof crypto v c -> Bool
Eq,Int -> DisjProof crypto v c -> ShowS
[DisjProof crypto v c] -> ShowS
DisjProof crypto v c -> String
(Int -> DisjProof crypto v c -> ShowS)
-> (DisjProof crypto v c -> String)
-> ([DisjProof crypto v c] -> ShowS)
-> Show (DisjProof crypto v c)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall crypto k (v :: k) c. Int -> DisjProof crypto v c -> ShowS
forall crypto k (v :: k) c. [DisjProof crypto v c] -> ShowS
forall crypto k (v :: k) c. DisjProof crypto v c -> String
showList :: [DisjProof crypto v c] -> ShowS
$cshowList :: forall crypto k (v :: k) c. [DisjProof crypto v c] -> ShowS
show :: DisjProof crypto v c -> String
$cshow :: forall crypto k (v :: k) c. DisjProof crypto v c -> String
showsPrec :: Int -> DisjProof crypto v c -> ShowS
$cshowsPrec :: forall crypto k (v :: k) c. Int -> DisjProof crypto v c -> ShowS
Show,(forall x. DisjProof crypto v c -> Rep (DisjProof crypto v c) x)
-> (forall x. Rep (DisjProof crypto v c) x -> DisjProof crypto v c)
-> Generic (DisjProof crypto v c)
forall x. Rep (DisjProof crypto v c) x -> DisjProof crypto v c
forall x. DisjProof crypto v c -> Rep (DisjProof crypto v c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto k (v :: k) c x.
Rep (DisjProof crypto v c) x -> DisjProof crypto v c
forall crypto k (v :: k) c x.
DisjProof crypto v c -> Rep (DisjProof crypto v c) x
$cto :: forall crypto k (v :: k) c x.
Rep (DisjProof crypto v c) x -> DisjProof crypto v c
$cfrom :: forall crypto k (v :: k) c x.
DisjProof crypto v c -> Rep (DisjProof crypto v c) x
Generic)
 deriving newtype (DisjProof crypto v c -> ()
(DisjProof crypto v c -> ()) -> NFData (DisjProof crypto v c)
forall a. (a -> ()) -> NFData a
forall crypto k (v :: k) c. DisjProof crypto v c -> ()
rnf :: DisjProof crypto v c -> ()
$crnf :: forall crypto k (v :: k) c. DisjProof crypto v c -> ()
NFData)
deriving newtype instance Reifies v Version => ToJSON (DisjProof crypto v c)
deriving newtype instance (Reifies v Version, CryptoParams crypto c) => FromJSON (DisjProof crypto v c)

-- | @('proveEncryption' elecPubKey voterZKP (prevDisjs,nextDisjs) (encNonce,enc))@
-- returns a 'DisjProof' that 'enc' 'encrypt's
-- the 'Disjunction' 'd' between 'prevDisjs' and 'nextDisjs'.
--
-- The prover proves that it knows an 'encNonce', such that:
-- @(enc '==' Encryption{encryption_nonce='groupGen' '^'encNonce, encryption_vault=elecPubKey'^'encNonce '*' groupGen'^'d})@
--
-- A /NIZK Disjunctive Chaum Pedersen Logarithm Equality/ is used.
--
-- DOC: Pierrick Gaudry. <https://hal.inria.fr/hal-01576379 Some ZK security proofs for Belenios>, 2017.
proveEncryption ::
 Reifies v Version =>
 CryptoParams crypto c =>
 Monad m => RandomGen r =>
 PublicKey crypto c -> ZKP ->
 ([Disjunction crypto c],[Disjunction crypto c]) ->
 (EncryptionNonce crypto c, Encryption crypto v c) ->
 S.StateT r m (DisjProof crypto v c)
proveEncryption :: 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
voterZKP ([PublicKey crypto c]
prevDisjs,[PublicKey crypto c]
nextDisjs) (EncryptionNonce crypto c
encNonce,Encryption crypto v c
enc) = do
	-- Fake proofs for all 'Disjunction's except the genuine one.
	[Proof crypto v c]
prevFakeProofs <- Int
-> StateT r m (Proof crypto v c) -> StateT r m [Proof crypto v c]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM ([PublicKey crypto c] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [PublicKey crypto c]
prevDisjs) StateT r m (Proof crypto v c)
forall k crypto c (m :: * -> *) r (v :: k).
(CryptoParams crypto c, Monad m, RandomGen r) =>
StateT r m (Proof crypto v c)
fakeProof
	[Proof crypto v c]
nextFakeProofs <- Int
-> StateT r m (Proof crypto v c) -> StateT r m [Proof crypto v c]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM ([PublicKey crypto c] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [PublicKey crypto c]
nextDisjs) StateT r m (Proof crypto v c)
forall k crypto c (m :: * -> *) r (v :: k).
(CryptoParams crypto c, Monad m, RandomGen r) =>
StateT r m (Proof crypto v c)
fakeProof
	let fakeChallengeSum :: EncryptionNonce crypto c
fakeChallengeSum =
		[EncryptionNonce crypto c] -> EncryptionNonce crypto c
forall a (f :: * -> *). (Additive a, Foldable f) => f a -> a
sum (Proof crypto v c -> EncryptionNonce crypto c
forall crypto k (v :: k) c. Proof crypto v c -> Challenge crypto c
proof_challenge (Proof crypto v c -> EncryptionNonce crypto c)
-> [Proof crypto v c] -> [EncryptionNonce crypto c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Proof crypto v c]
prevFakeProofs) EncryptionNonce crypto c
-> EncryptionNonce crypto c -> EncryptionNonce crypto c
forall a. Additive a => a -> a -> a
+
		[EncryptionNonce crypto c] -> EncryptionNonce crypto c
forall a (f :: * -> *). (Additive a, Foldable f) => f a -> a
sum (Proof crypto v c -> EncryptionNonce crypto c
forall crypto k (v :: k) c. Proof crypto v c -> Challenge crypto c
proof_challenge (Proof crypto v c -> EncryptionNonce crypto c)
-> [Proof crypto v c] -> [EncryptionNonce crypto c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Proof crypto v c]
nextFakeProofs)
	let statement :: ByteString
statement = ZKP -> Encryption crypto v c -> ByteString
forall k crypto c (v :: k).
CryptoParams crypto c =>
ZKP -> Encryption crypto v c -> ByteString
encryptionStatement ZKP
voterZKP Encryption crypto v c
enc
	Proof crypto v c
genuineProof <- EncryptionNonce crypto c
-> [PublicKey crypto c]
-> Oracle [] crypto c
-> StateT r m (Proof crypto v c)
forall k crypto (v :: k) c (list :: * -> *) (m :: * -> *) r.
(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)
prove EncryptionNonce crypto c
encNonce [PublicKey crypto c
forall crypto c. CryptoParams crypto c => G crypto c
groupGen, PublicKey crypto c
elecPubKey] (Oracle [] crypto c -> StateT r m (Proof crypto v c))
-> Oracle [] crypto c -> StateT r m (Proof crypto v c)
forall a b. (a -> b) -> a -> b
$ \[PublicKey crypto c]
genuineCommitments ->
		let validCommitments :: [PublicKey crypto c]
-> [Proof crypto v c] -> [[PublicKey crypto c]]
validCommitments = (PublicKey crypto c -> Proof crypto v c -> [PublicKey crypto c])
-> [PublicKey crypto c]
-> [Proof crypto v c]
-> [[PublicKey crypto c]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
List.zipWith (PublicKey crypto c
-> Encryption crypto v c
-> PublicKey crypto c
-> Proof crypto v c
-> [PublicKey crypto c]
forall k (v :: k) crypto c.
(Reifies v Version, CryptoParams crypto c) =>
PublicKey crypto c
-> Encryption crypto v c
-> PublicKey crypto c
-> Proof crypto v c
-> [PublicKey crypto c]
encryptionCommitments PublicKey crypto c
elecPubKey Encryption crypto v c
enc) in
		let prevCommitments :: [[PublicKey crypto c]]
prevCommitments = [PublicKey crypto c]
-> [Proof crypto v c] -> [[PublicKey crypto c]]
validCommitments [PublicKey crypto c]
prevDisjs [Proof crypto v c]
prevFakeProofs in
		let nextCommitments :: [[PublicKey crypto c]]
nextCommitments = [PublicKey crypto c]
-> [Proof crypto v c] -> [[PublicKey crypto c]]
validCommitments [PublicKey crypto c]
nextDisjs [Proof crypto v c]
nextFakeProofs in
		let commitments :: [PublicKey crypto c]
commitments = [[PublicKey crypto c]] -> [PublicKey crypto c]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join [[PublicKey crypto c]]
prevCommitments [PublicKey crypto c]
-> [PublicKey crypto c] -> [PublicKey crypto c]
forall a. Semigroup a => a -> a -> a
<> [PublicKey crypto c]
genuineCommitments [PublicKey crypto c]
-> [PublicKey crypto c] -> [PublicKey crypto c]
forall a. Semigroup a => a -> a -> a
<> [[PublicKey crypto c]] -> [PublicKey crypto c]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join [[PublicKey crypto c]]
nextCommitments in
		let challenge :: EncryptionNonce crypto c
challenge = ByteString -> Oracle [] crypto c
forall crypto c.
CryptoParams crypto c =>
ByteString -> [G crypto c] -> E crypto c
hash ByteString
statement [PublicKey crypto c]
commitments in
		let genuineChallenge :: EncryptionNonce crypto c
genuineChallenge = EncryptionNonce crypto c
challenge EncryptionNonce crypto c
-> EncryptionNonce crypto c -> EncryptionNonce crypto c
forall a. Ring a => a -> a -> a
- EncryptionNonce crypto c
fakeChallengeSum in
		EncryptionNonce crypto c
genuineChallenge
		-- NOTE: here by construction (genuineChallenge == challenge - fakeChallengeSum)
		-- thus (sum (proof_challenge <$> proofs) == challenge)
		-- as checked in 'verifyEncryption'.
	let proofs :: [Proof crypto v c]
proofs = [Proof crypto v c]
prevFakeProofs [Proof crypto v c] -> [Proof crypto v c] -> [Proof crypto v c]
forall a. Semigroup a => a -> a -> a
<> (Proof crypto v c
genuineProof Proof crypto v c -> [Proof crypto v c] -> [Proof crypto v c]
forall a. a -> [a] -> [a]
: [Proof crypto v c]
nextFakeProofs)
	DisjProof crypto v c -> StateT r m (DisjProof crypto v c)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Proof crypto v c] -> DisjProof crypto v c
forall k crypto (v :: k) c.
[Proof crypto v c] -> DisjProof crypto v c
DisjProof [Proof crypto v c]
proofs)

verifyEncryption ::
 Reifies v Version =>
 CryptoParams crypto c =>
 Monad m =>
 PublicKey crypto c -> ZKP ->
 [Disjunction crypto c] -> (Encryption crypto v c, DisjProof crypto v c) ->
 ExceptT ErrorVerifyEncryption m Bool
verifyEncryption :: 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
voterZKP [PublicKey crypto c]
disjs (Encryption crypto v c
enc, DisjProof [Proof crypto v c]
proofs) =
	case (PublicKey crypto c -> Proof crypto v c -> [PublicKey crypto c])
-> [PublicKey crypto c]
-> [Proof crypto v c]
-> Maybe [[PublicKey crypto c]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> Maybe [c]
isoZipWith (PublicKey crypto c
-> Encryption crypto v c
-> PublicKey crypto c
-> Proof crypto v c
-> [PublicKey crypto c]
forall k (v :: k) crypto c.
(Reifies v Version, CryptoParams crypto c) =>
PublicKey crypto c
-> Encryption crypto v c
-> PublicKey crypto c
-> Proof crypto v c
-> [PublicKey crypto c]
encryptionCommitments PublicKey crypto c
elecPubKey Encryption crypto v c
enc) [PublicKey crypto c]
disjs [Proof crypto v c]
proofs of
	 Maybe [[PublicKey crypto c]]
Nothing ->
		ErrorVerifyEncryption -> ExceptT ErrorVerifyEncryption m Bool
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (ErrorVerifyEncryption -> ExceptT ErrorVerifyEncryption m Bool)
-> ErrorVerifyEncryption -> ExceptT ErrorVerifyEncryption m Bool
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> ErrorVerifyEncryption
ErrorVerifyEncryption_InvalidProofLength
		 (Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> Int -> Natural
forall a b. (a -> b) -> a -> b
$ [Proof crypto v c] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [Proof crypto v c]
proofs)
		 (Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> Int -> Natural
forall a b. (a -> b) -> a -> b
$ [PublicKey crypto c] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [PublicKey crypto c]
disjs)
	 Just [[PublicKey crypto c]]
commitments ->
		Bool -> ExceptT ErrorVerifyEncryption m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> ExceptT ErrorVerifyEncryption m Bool)
-> Bool -> ExceptT ErrorVerifyEncryption m Bool
forall a b. (a -> b) -> a -> b
$ Challenge crypto c
challengeSum 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 -> Encryption crypto v c -> ByteString
forall k crypto c (v :: k).
CryptoParams crypto c =>
ZKP -> Encryption crypto v c -> ByteString
encryptionStatement ZKP
voterZKP Encryption crypto v c
enc) ([[PublicKey crypto c]] -> [PublicKey crypto c]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join [[PublicKey crypto c]]
commitments)
	where
	challengeSum :: Challenge crypto c
challengeSum = [Challenge crypto c] -> Challenge crypto c
forall a (f :: * -> *). (Additive a, Foldable f) => f a -> a
sum (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 -> Challenge crypto c)
-> [Proof crypto v c] -> [Challenge crypto c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Proof crypto v c]
proofs)

-- ** Hashing
encryptionStatement ::
 CryptoParams crypto c =>
 ZKP -> Encryption crypto v c -> BS.ByteString
encryptionStatement :: ZKP -> Encryption crypto v c -> ByteString
encryptionStatement (ZKP ByteString
voterZKP) Encryption{G crypto c
encryption_vault :: G crypto c
encryption_nonce :: 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
..} =
	ByteString
"prove|"ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>ByteString
voterZKPByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>ByteString
"|"
	 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> G crypto c -> ByteString
forall n. ToNatural n => n -> ByteString
bytesNat G crypto c
encryption_nonceByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>ByteString
","
	 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> G crypto c -> ByteString
forall n. ToNatural n => n -> ByteString
bytesNat G crypto c
encryption_vaultByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>ByteString
"|"

-- | @('encryptionCommitments' elecPubKey enc disj proof)@
-- returns the 'Commitment's with only the knowledge of the verifier.
--
-- For the prover the 'Proof' comes from @fakeProof@,
-- and for the verifier the 'Proof' comes from the prover.
encryptionCommitments ::
 Reifies v Version =>
 CryptoParams crypto c =>
 PublicKey crypto c -> Encryption crypto v c ->
 Disjunction crypto c -> Proof crypto v c -> [G crypto c]
encryptionCommitments :: PublicKey crypto c
-> Encryption crypto v c
-> PublicKey crypto c
-> Proof crypto v c
-> [PublicKey crypto c]
encryptionCommitments PublicKey crypto c
elecPubKey Encryption{PublicKey crypto c
encryption_vault :: PublicKey crypto c
encryption_nonce :: PublicKey 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
..} PublicKey crypto c
disj Proof crypto v c
proof =
	[ Proof crypto v c
-> PublicKey crypto c -> PublicKey crypto c -> PublicKey crypto c
forall k crypto (v :: k) c.
(Reifies v Version, CryptoParams crypto c) =>
Proof crypto v c -> G crypto c -> G crypto c -> G crypto c
commit Proof crypto v c
proof PublicKey crypto c
forall crypto c. CryptoParams crypto c => G crypto c
groupGen PublicKey crypto c
encryption_nonce
	  -- == groupGen ^ nonce if 'Proof' comes from 'prove'.
	  -- base==groupGen, basePowSec==groupGen^encNonce.
	, Proof crypto v c
-> PublicKey crypto c -> PublicKey crypto c -> PublicKey crypto c
forall k crypto (v :: k) c.
(Reifies v Version, CryptoParams crypto c) =>
Proof crypto v c -> G crypto c -> G crypto c -> G crypto c
commit Proof crypto v c
proof PublicKey crypto c
elecPubKey (PublicKey crypto c
encryption_vaultPublicKey crypto c -> PublicKey crypto c -> PublicKey crypto c
forall a. Semiring a => a -> a -> a
*PublicKey crypto c
disj)
	  -- == elecPubKey ^ nonce if 'Proof' comes from 'prove'
	  -- and 'encryption_vault' encrypts (- logBase groupGen disj).
	  -- base==elecPubKey, basePowSec==elecPubKey^encNonce.
	]

-- ** Type 'ErrorVerifyEncryption'
-- | Error raised by 'verifyEncryption'.
data ErrorVerifyEncryption
 =   ErrorVerifyEncryption_InvalidProofLength Natural Natural
     -- ^ When the number of proofs is different than
     -- the number of 'Disjunction's.
 deriving (ErrorVerifyEncryption -> ErrorVerifyEncryption -> Bool
(ErrorVerifyEncryption -> ErrorVerifyEncryption -> Bool)
-> (ErrorVerifyEncryption -> ErrorVerifyEncryption -> Bool)
-> Eq ErrorVerifyEncryption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorVerifyEncryption -> ErrorVerifyEncryption -> Bool
$c/= :: ErrorVerifyEncryption -> ErrorVerifyEncryption -> Bool
== :: ErrorVerifyEncryption -> ErrorVerifyEncryption -> Bool
$c== :: ErrorVerifyEncryption -> ErrorVerifyEncryption -> Bool
Eq,Int -> ErrorVerifyEncryption -> ShowS
[ErrorVerifyEncryption] -> ShowS
ErrorVerifyEncryption -> String
(Int -> ErrorVerifyEncryption -> ShowS)
-> (ErrorVerifyEncryption -> String)
-> ([ErrorVerifyEncryption] -> ShowS)
-> Show ErrorVerifyEncryption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorVerifyEncryption] -> ShowS
$cshowList :: [ErrorVerifyEncryption] -> ShowS
show :: ErrorVerifyEncryption -> String
$cshow :: ErrorVerifyEncryption -> String
showsPrec :: Int -> ErrorVerifyEncryption -> ShowS
$cshowsPrec :: Int -> ErrorVerifyEncryption -> ShowS
Show)

-- * Type 'Signature'
-- | Schnorr-like signature.
--
-- Used by each voter to sign his/her encrypted 'Ballot'
-- using his/her 'Credential',
-- in order to avoid ballot stuffing.
data Signature crypto v c = Signature
 { Signature crypto v c -> PublicKey crypto c
signature_publicKey :: !(PublicKey crypto c)
   -- ^ Verification key.
 , Signature crypto v c -> Proof crypto v c
signature_proof     :: !(Proof crypto v c)
 } deriving ((forall x. Signature crypto v c -> Rep (Signature crypto v c) x)
-> (forall x. Rep (Signature crypto v c) x -> Signature crypto v c)
-> Generic (Signature crypto v c)
forall x. Rep (Signature crypto v c) x -> Signature crypto v c
forall x. Signature crypto v c -> Rep (Signature crypto v c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto k (v :: k) c x.
Rep (Signature crypto v c) x -> Signature crypto v c
forall crypto k (v :: k) c x.
Signature crypto v c -> Rep (Signature crypto v c) x
$cto :: forall crypto k (v :: k) c x.
Rep (Signature crypto v c) x -> Signature crypto v c
$cfrom :: forall crypto k (v :: k) c x.
Signature crypto v c -> Rep (Signature crypto v c) x
Generic)
deriving instance (NFData crypto, NFData (G crypto c)) => NFData (Signature crypto v c)
instance
 ( Reifies v Version
 , CryptoParams crypto c
 ) => ToJSON (Signature crypto v c) where
	toJSON :: Signature crypto v c -> Value
toJSON (Signature PublicKey crypto c
pubKey Proof{E crypto c
proof_response :: E crypto c
proof_challenge :: E crypto c
proof_response :: forall crypto k (v :: k) c. Proof crypto v c -> Challenge crypto c
proof_challenge :: forall crypto k (v :: k) c. Proof crypto v c -> Challenge crypto c
..}) =
		[Pair] -> Value
JSON.object
		 [ Text
"public_key" Text -> PublicKey crypto c -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PublicKey crypto c
pubKey
		 , Text
"challenge"  Text -> E crypto c -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= E crypto c
proof_challenge
		 , Text
"response"   Text -> E crypto c -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= E crypto c
proof_response
		 ]
	toEncoding :: Signature crypto v c -> Encoding
toEncoding (Signature PublicKey crypto c
pubKey Proof{E crypto c
proof_response :: E crypto c
proof_challenge :: E crypto c
proof_response :: forall crypto k (v :: k) c. Proof crypto v c -> Challenge crypto c
proof_challenge :: forall crypto k (v :: k) c. Proof crypto v c -> Challenge crypto c
..}) =
		Series -> Encoding
JSON.pairs
		 (  Text
"public_key" Text -> PublicKey crypto c -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PublicKey crypto c
pubKey
		 Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
"challenge"  Text -> E crypto c -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= E crypto c
proof_challenge
		 Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
"response"   Text -> E crypto c -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= E crypto c
proof_response
		 )
instance
 ( Reifies v Version
 , CryptoParams crypto c
 ) => FromJSON (Signature crypto v c) where
	parseJSON :: Value -> Parser (Signature crypto v c)
parseJSON = String
-> (Object -> Parser (Signature crypto v c))
-> Value
-> Parser (Signature crypto v c)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Signature" ((Object -> Parser (Signature crypto v c))
 -> Value -> Parser (Signature crypto v c))
-> (Object -> Parser (Signature crypto v c))
-> Value
-> Parser (Signature crypto v c)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
		PublicKey crypto c
signature_publicKey <- Object
o Object -> Text -> Parser (PublicKey crypto c)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"public_key"
		Challenge crypto c
proof_challenge     <- Object
o Object -> Text -> Parser (Challenge crypto c)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"challenge"
		Challenge crypto c
proof_response      <- Object
o Object -> Text -> Parser (Challenge crypto c)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"response"
		let signature_proof :: Proof crypto v c
signature_proof = Proof :: forall k crypto (v :: k) c.
Challenge crypto c -> Challenge crypto c -> Proof crypto v c
Proof{Challenge crypto c
proof_response :: Challenge crypto c
proof_challenge :: Challenge crypto c
proof_response :: Challenge crypto c
proof_challenge :: Challenge crypto c
..}
		Signature crypto v c -> Parser (Signature crypto v c)
forall (m :: * -> *) a. Monad m => a -> m a
return 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
..}