summaryrefslogtreecommitdiff
path: root/tests/HUnit/Election.hs
blob: 465f910b6b49346c170b7f97b417b0a151b1f245 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
module HUnit.Election where

import Test.Tasty.HUnit
import qualified Data.List as List
import qualified System.Random as Random

import Voting.Protocol

import Utils

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

testsEncryptBallot :: forall q. Params q => TestTree
testsEncryptBallot =
	testGroup (paramsName @q)
	 [ testEncryptBallot @q 0
		 [Question "q1" ["a1","a2","a3"] zero one]
		 [[True, False, False]]
		 (Right True)
	 , testEncryptBallot @q 0
		 [Question "q1" ["a1","a2","a3"] zero one]
		 [[False, False, False]]
		 (Right True)
	 , testEncryptBallot @q 0
		 [Question "q1" ["a1","a2","a3"] zero one]
		 [[False, False, False]]
		 (Right True)
	 , testEncryptBallot @q 0
		 [Question "q1" [] zero one]
		 []
		 (Left (ErrorBallot_WrongNumberOfAnswers 0 1))
	 , testEncryptBallot @q 0
		 [Question "q1" ["a1","a2"] one one]
		 [[True]]
		 (Left (ErrorBallot_Answer (ErrorAnswer_WrongNumberOfOpinions 1 2)))
	 , testEncryptBallot @q 0
		 [Question "q1" ["a1","a2","a3"] zero one]
		 [[True, True, False]]
		 (Left (ErrorBallot_Answer (ErrorAnswer_WrongSumOfOpinions 2 0 1)))
	 , testEncryptBallot @q 0
		 [Question "q1" ["a1","a2","a3"] one one]
		 [[False, False, False]]
		 (Left (ErrorBallot_Answer (ErrorAnswer_WrongSumOfOpinions 0 1 1)))
	 , testEncryptBallot @q 0
		 [Question "q1" ["a1","a2"] one one]
		 [[False, False, True]]
		 (Left (ErrorBallot_Answer (ErrorAnswer_WrongNumberOfOpinions 3 2)))
	 , testEncryptBallot @q 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 ::
 forall q. SubGroup q =>
 Int -> [Question q] -> [[Bool]] ->
 Either ErrorBallot Bool ->
 TestTree
testEncryptBallot seed quests opins exp =
	let got =
		runExcept $
		(`evalStateT` Random.mkStdGen seed) $ do
			uuid <- randomUUID
			cred <- randomCredential
			let ballotSecKey = credentialSecretKey @q uuid cred
			elecPubKey <- publicKey <$> randomSecretKey
			let elec = Election
				 { election_name        = "election"
				 , election_description = "description"
				 , election_PublicKey   = elecPubKey
				 , election_questions   = quests
				 , election_uuid        = uuid
				 , election_hash        = Hash "" -- FIXME: when implemented
				 }
			verifyBallot elec
			 <$> encryptBallot elec (Just ballotSecKey) opins
	in
	testCase (show opins) $
		got @?= exp