yarn: upgrade to purescript@^0.13.5 and spago@^0.12.1
[majurity.git] / hjugement-protocol / src / Voting / Protocol / Tally.hs
index 46bfd864d41046845ffbe26c6306c8973fdc9cd4..3f3c986dc238e57750a607e00a06df29de335ffb 100644 (file)
@@ -1,5 +1,6 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE UndecidableInstances #-} -- for Reifies instances
 module Voting.Protocol.Tally where
@@ -7,29 +8,35 @@ module Voting.Protocol.Tally where
 import Control.DeepSeq (NFData)
 import Control.Monad (Monad(..), mapM, unless)
 import Control.Monad.Trans.Except (Except, ExceptT, throwE)
-import Data.Aeson (ToJSON(..),FromJSON(..))
+import Data.Aeson (ToJSON(..), FromJSON(..), (.:), (.=))
 import Data.Eq (Eq(..))
-import Data.Function (($))
+import Data.Function (($), (.))
 import Data.Functor ((<$>))
 import Data.Maybe (maybe)
 import Data.Semigroup (Semigroup(..))
-import Data.Tuple (fst)
+import Data.Reflection (Reifies(..))
+import Data.Tuple (fst, snd)
 import GHC.Generics (Generic)
 import Numeric.Natural (Natural)
-import Prelude (fromIntegral)
+import System.Random (RandomGen)
 import Text.Show (Show(..))
+import qualified Data.Aeson as JSON
+import qualified Data.Aeson.Types as JSON
+import qualified Data.Aeson.Encoding as JSON
 import qualified Control.Monad.Trans.State.Strict as S
 import qualified Data.ByteString as BS
 import qualified Data.List as List
 import qualified Data.Map.Strict as Map
 
 import Voting.Protocol.Utils
-import Voting.Protocol.FFC
+import Voting.Protocol.Arithmetic
+import Voting.Protocol.Version
+import Voting.Protocol.Cryptography
 import Voting.Protocol.Credential
 import Voting.Protocol.Election
 
 -- * Type 'Tally'
-data Tally c = Tally
+data Tally crypto v c = Tally
  { tally_countMax :: !Natural
    -- ^ The maximal number of supportive 'Opinion's that a choice can get,
    -- which is here the same as the number of 'Ballot's.
@@ -37,44 +44,89 @@ data Tally c = Tally
    -- Used in 'proveTally' to decrypt the actual
    -- count of votes obtained by a choice,
    -- by precomputing all powers of 'groupGen's up to it.
- , tally_encByChoiceByQuest :: !(EncryptedTally c)
+ , tally_encByChoiceByQuest :: !(EncryptedTally crypto v c)
    -- ^ 'Encryption' by 'Question' by 'Ballot'.
- , tally_decShareByTrustee :: ![DecryptionShare c]
+ , tally_decShareByTrustee :: ![DecryptionShare crypto v c]
    -- ^ 'DecryptionShare' by trustee.
  , tally_countByChoiceByQuest :: ![[Natural]]
    -- ^ The decrypted count of supportive 'Opinion's, by choice by 'Question'.
- } deriving (Eq,Show,Generic,NFData)
-deriving instance Reifies c FFC => ToJSON (Tally c)
-deriving instance Reifies c FFC => FromJSON (Tally c)
+ } deriving (Generic)
+deriving instance Eq (G crypto c) => Eq (Tally crypto v c)
+deriving instance (Show (G crypto c), Show (G crypto c)) => Show (Tally crypto v c)
+deriving instance NFData (G crypto c) => NFData (Tally crypto v c)
+instance
+ ( Reifies v Version
+ , CryptoParams crypto c
+ ) => ToJSON (Tally crypto v c) where
+       toJSON Tally{..} =
+               JSON.object
+                [ "num_tallied"         .= tally_countMax
+                , "encrypted_tally"     .= tally_encByChoiceByQuest
+                , "partial_decryptions" .= tally_decShareByTrustee
+                , "result"              .= tally_countByChoiceByQuest
+                ]
+       toEncoding Tally{..} =
+               JSON.pairs
+                (  "num_tallied"         .= tally_countMax
+                <> "encrypted_tally"     .= tally_encByChoiceByQuest
+                <> "partial_decryptions" .= tally_decShareByTrustee
+                <> "result"              .= tally_countByChoiceByQuest
+                )
+instance
+ ( Reifies v Version
+ , CryptoParams crypto c
+ ) => FromJSON (Tally crypto v c) where
+       parseJSON = JSON.withObject "Tally" $ \o -> do
+               tally_countMax             <- o .: "num_tallied"
+               tally_encByChoiceByQuest   <- o .: "encrypted_tally"
+               tally_decShareByTrustee    <- o .: "partial_decryptions"
+               tally_countByChoiceByQuest <- o .: "result"
+               return Tally{..}
 
 -- ** Type 'EncryptedTally'
 -- | 'Encryption' by choice by 'Question'.
-type EncryptedTally c = [[Encryption c]]
+type EncryptedTally crypto v c = [[Encryption crypto v c]]
 
 -- | @('encryptedTally' ballots)@
 -- returns the sum of the 'Encryption's of the given @ballots@,
 -- along with the number of 'Ballot's.
-encryptedTally :: Reifies c FFC => [Ballot c] -> (EncryptedTally c, Natural)
-encryptedTally ballots =
-       ( List.foldr (\Ballot{..} ->
-               List.zipWith (\Answer{..} ->
-                       List.zipWith (+)
-                        (fst <$> answer_opinions))
-                ballot_answers)
-        (List.repeat (List.repeat zero))
-        ballots
-       , fromIntegral $ List.length ballots
+encryptedTally ::
+ CryptoParams crypto c =>
+ [Ballot crypto v c] -> (EncryptedTally crypto v c, Natural)
+encryptedTally = List.foldr insertEncryptedTally emptyEncryptedTally
+
+-- | The initial 'EncryptedTally' which tallies no 'Ballot'.
+emptyEncryptedTally ::
+ CryptoParams crypto c =>
+ (EncryptedTally crypto v c, Natural)
+emptyEncryptedTally = (List.repeat (List.repeat zero), 0)
+
+-- | @('insertEncryptedTally' ballot encTally)@
+-- returns the 'EncryptedTally' adding the votes of the given @(ballot)@
+-- to those of the given @(encTally)@.
+insertEncryptedTally ::
+ CryptoParams crypto c =>
+ Ballot crypto v c ->
+ (EncryptedTally crypto v c, Natural) ->
+ (EncryptedTally crypto v c, Natural)
+insertEncryptedTally Ballot{..} (encTally, numBallots) =
+       ( List.zipWith
+                (\Answer{..} -> List.zipWith (+) (fst <$> answer_opinions))
+                ballot_answers
+                encTally
+       , numBallots+1
        )
 
 -- ** Type 'DecryptionShareCombinator'
-type DecryptionShareCombinator c =
-       EncryptedTally c -> [DecryptionShare c] -> Except ErrorTally [[DecryptionFactor c]]
+type DecryptionShareCombinator crypto v c =
+ EncryptedTally crypto v c ->
+ [DecryptionShare crypto v c] ->
+ Except ErrorTally [[DecryptionFactor crypto c]]
 
 proveTally ::
- Reifies c FFC =>
- (EncryptedTally c, Natural) -> [DecryptionShare c] ->
- DecryptionShareCombinator c ->
- Except ErrorTally (Tally c)
+ CryptoParams crypto c =>
+ (EncryptedTally crypto v c, Natural) -> [DecryptionShare crypto v c] ->
+ DecryptionShareCombinator crypto v c -> Except ErrorTally (Tally crypto v c)
 proveTally
  (tally_encByChoiceByQuest, tally_countMax)
  tally_decShareByTrustee
@@ -96,8 +148,9 @@ proveTally
        return Tally{..}
 
 verifyTally ::
- Reifies c FFC =>
- Tally c -> DecryptionShareCombinator c ->
+ CryptoParams crypto c =>
+ Tally crypto v c ->
+ DecryptionShareCombinator crypto v c ->
  Except ErrorTally ()
 verifyTally Tally{..} decShareCombinator = do
        decFactorByChoiceByQuest <- decShareCombinator tally_encByChoiceByQuest tally_decShareByTrustee
@@ -114,7 +167,42 @@ verifyTally Tally{..} decShareCombinator = do
 -- ** Type 'DecryptionShare'
 -- | A decryption share is a 'DecryptionFactor' and a decryption 'Proof', by choice by 'Question'.
 -- Computed by a trustee in 'proveDecryptionShare'.
-type DecryptionShare c = [[(DecryptionFactor c, Proof c)]]
+newtype DecryptionShare crypto v c = DecryptionShare
+ { unDecryptionShare :: [[(DecryptionFactor crypto c, Proof crypto v c)]] }
+ deriving (Generic)
+deriving instance Eq (G crypto c) => Eq (DecryptionShare crypto v c)
+deriving instance Show (G crypto c) => Show (DecryptionShare crypto v c)
+deriving newtype instance NFData (G crypto c) => NFData (DecryptionShare crypto v c)
+instance
+ ( Reifies v Version
+ , ToJSON (G crypto c)
+ ) => ToJSON (DecryptionShare crypto v c) where
+       toJSON (DecryptionShare decByChoiceByQuest) =
+               JSON.object
+                [ "decryption_factors" .=
+                       toJSONList (((toJSON . fst) <$>) <$> decByChoiceByQuest)
+                , "decryption_proofs" .=
+                       toJSONList (((toJSON . snd) <$>) <$> decByChoiceByQuest)
+                ]
+       toEncoding (DecryptionShare decByChoiceByQuest) =
+               JSON.pairs $
+                       JSON.pair "decryption_factors"
+                        (JSON.list (JSON.list (toEncoding . fst)) decByChoiceByQuest) <>
+                       JSON.pair "decryption_proofs"
+                        (JSON.list (JSON.list (toEncoding . snd)) decByChoiceByQuest)
+instance
+ ( Reifies v Version
+ , CryptoParams crypto c
+ ) => FromJSON (DecryptionShare crypto v c) where
+       parseJSON = JSON.withObject "DecryptionShare" $ \o -> do
+               decFactors <- o .: "decryption_factors"
+               decProofs  <- o .: "decryption_proofs"
+               let err msg = JSON.typeMismatch ("DecryptionShare: "<>msg) (JSON.Object o)
+               DecryptionShare
+                <$> isoZipWithM (err "inconsistent number of questions")
+                        (isoZipWithM (err "inconsistent number of choices")
+                                (\a b -> return (a, b)))
+                decFactors decProofs
 
 -- *** Type 'DecryptionFactor'
 -- | @'encryption_nonce' '^'trusteeSecKey@
@@ -122,20 +210,27 @@ type DecryptionFactor = G
 
 -- @('proveDecryptionShare' encByChoiceByQuest trusteeSecKey)@
 proveDecryptionShare ::
- Monad m => Reifies c FFC => RandomGen r =>
- EncryptedTally c -> SecretKey c -> S.StateT r m (DecryptionShare c)
+ Reifies v Version =>
+ CryptoParams crypto c =>
+ Key crypto =>
+ Monad m => RandomGen r =>
+ EncryptedTally crypto v c -> SecretKey crypto c -> S.StateT r m (DecryptionShare crypto v c)
 proveDecryptionShare encByChoiceByQuest trusteeSecKey =
+       (DecryptionShare <$>) $
        (proveDecryptionFactor trusteeSecKey `mapM`) `mapM` encByChoiceByQuest
 
 proveDecryptionFactor ::
- Monad m => Reifies c FFC => RandomGen r =>
- SecretKey c -> Encryption c -> S.StateT r m (DecryptionFactor c, Proof c)
+ Reifies v Version => 
+ CryptoParams crypto c =>
+ Key crypto =>
+ Monad m => RandomGen r =>
+ SecretKey crypto c -> Encryption crypto v c -> S.StateT r m (DecryptionFactor crypto c, Proof crypto v c)
 proveDecryptionFactor trusteeSecKey Encryption{..} = do
        proof <- prove trusteeSecKey [groupGen, encryption_nonce] (hash zkp)
        return (encryption_nonce^trusteeSecKey, proof)
        where zkp = decryptionShareStatement (publicKey trusteeSecKey)
 
-decryptionShareStatement :: Reifies c FFC => PublicKey c -> BS.ByteString
+decryptionShareStatement :: CryptoParams crypto c => PublicKey crypto c -> BS.ByteString
 decryptionShareStatement pubKey =
        "decrypt|"<>bytesNat pubKey<>"|"
 
@@ -160,10 +255,12 @@ data ErrorTally
 -- (supposedly submitted by a trustee whose 'PublicKey' is 'trusteePubKey')
 -- is valid with respect to the 'EncryptedTally' 'encTally'.
 verifyDecryptionShare ::
- Monad m => Reifies c FFC =>
- EncryptedTally c -> PublicKey c -> DecryptionShare c ->
+ Reifies v Version =>
+ CryptoParams crypto c =>
+ Monad m =>
+ EncryptedTally crypto v c -> PublicKey crypto c -> DecryptionShare crypto v c ->
  ExceptT ErrorTally m ()
-verifyDecryptionShare encByChoiceByQuest trusteePubKey =
+verifyDecryptionShare encByChoiceByQuest trusteePubKey (DecryptionShare decShare) =
        let zkp = decryptionShareStatement trusteePubKey in
        isoZipWithM_ (throwE ErrorTally_NumberOfQuestions)
         (isoZipWithM_ (throwE ErrorTally_NumberOfChoices) $
@@ -173,10 +270,13 @@ verifyDecryptionShare encByChoiceByQuest trusteePubKey =
                 , commit proof encryption_nonce decFactor
                 ]) $ throwE ErrorTally_WrongProof)
         encByChoiceByQuest
+        decShare
 
 verifyDecryptionShareByTrustee ::
- Monad m => Reifies c FFC =>
- EncryptedTally c -> [PublicKey c] -> [DecryptionShare c] ->
+ Reifies v Version =>
+ CryptoParams crypto c =>
+ Monad m =>
+ EncryptedTally crypto v c -> [PublicKey crypto c] -> [DecryptionShare crypto v c] ->
  ExceptT ErrorTally m ()
 verifyDecryptionShareByTrustee encTally =
        isoZipWithM_ (throwE ErrorTally_NumberOfTrustees)