Election.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
module HUnit.Election where

import Test.Tasty.HUnit
import qualified Data.Aeson as JSON
import qualified Data.List as List
import qualified Data.Text as Text
import qualified System.Random as Random

import Voting.Protocol

import Utils

hunit :: TestTree
hunit = testGroup "Election"
 [ testGroup "groupGenInverses"
	 [ testCase "WeakParams" $
		reify weakFFC $ \(Proxy::Proxy c) ->
			List.take 10 (groupGenInverses @c) @?=
				[groupGen^neg (fromNatural n) | n <- [0..9]]
	 , testCase "BeleniosParams" $
		reify beleniosFFC $ \(Proxy::Proxy c) ->
			List.take 10 (groupGenInverses @c) @?=
				[groupGen^neg (fromNatural n) | n <- [0..9]]
	 ]
 , testGroup "encryptBallot" $
	 [ testsEncryptBallot weakFFC
	 , testsEncryptBallot beleniosFFC
	 ]
 ]

testsEncryptBallot :: FFC -> TestTree
testsEncryptBallot ffc =
	testGroup (Text.unpack $ ffc_name ffc)
	 [ testEncryptBallot ffc 0
		 [Question "q1" ["a1","a2","a3"] zero one]
		 [[True, False, False]]
		 (Right True)
	 , testEncryptBallot ffc 0
		 [Question "q1" ["a1","a2","a3"] zero one]
		 [[False, False, False]]
		 (Right True)
	 , testEncryptBallot ffc 0
		 [Question "q1" ["a1","a2","a3"] zero one]
		 [[False, False, False]]
		 (Right True)
	 , testEncryptBallot ffc 0
		 [Question "q1" [] zero one]
		 []
		 (Left (ErrorBallot_WrongNumberOfAnswers 0 1))
	 , testEncryptBallot ffc 0
		 [Question "q1" ["a1","a2"] one one]
		 [[True]]
		 (Left (ErrorBallot_Answer (ErrorAnswer_WrongNumberOfOpinions 1 2)))
	 , testEncryptBallot ffc 0
		 [Question "q1" ["a1","a2","a3"] zero one]
		 [[True, True, False]]
		 (Left (ErrorBallot_Answer (ErrorAnswer_WrongSumOfOpinions 2 0 1)))
	 , testEncryptBallot ffc 0
		 [Question "q1" ["a1","a2","a3"] one one]
		 [[False, False, False]]
		 (Left (ErrorBallot_Answer (ErrorAnswer_WrongSumOfOpinions 0 1 1)))
	 , testEncryptBallot ffc 0
		 [Question "q1" ["a1","a2"] one one]
		 [[False, False, True]]
		 (Left (ErrorBallot_Answer (ErrorAnswer_WrongNumberOfOpinions 3 2)))
	 , testEncryptBallot ffc 0
		 [ Question "q1" ["a11","a12","a13"] zero (one+one)
		 , Question "q2" ["a21","a22","a23"] one one
		 ]
		 [ [True, False, True]
		 , [False, True, False] ]
		 (Right True)
	 ]

testEncryptBallot ::
 FFC -> Int -> [Question] -> [[Bool]] ->
 Either ErrorBallot Bool ->
 TestTree
testEncryptBallot ffc seed quests opins exp =
	let got =
		reify ffc $ \(Proxy::Proxy c) ->
		runExcept $
		(`evalStateT` Random.mkStdGen seed) $ do
			uuid <- randomUUID
			cred <- randomCredential
			let ballotSecKey = credentialSecretKey @c uuid cred
			elecPubKey <- publicKey <$> randomSecretKey
			let elec = Election
				 { election_name        = "election"
				 , election_description = "description"
				 , election_crypto      = ElectionCrypto_FFC ffc elecPubKey
				 , election_questions   = quests
				 , election_uuid        = uuid
				 , election_hash        = hashJSON JSON.Null
				 }
			verifyBallot elec
			 <$> encryptBallot elec (Just ballotSecKey) opins
	in
	testCase (show opins) $
		got @?= exp