]> Git — Sourcephile - majurity.git/blob - hjugement-protocol/tests/HUnit/Election.hs
protocol: add benchmarks
[majurity.git] / hjugement-protocol / tests / HUnit / Election.hs
1 {-# LANGUAGE AllowAmbiguousTypes #-}
2 {-# LANGUAGE DataKinds #-}
3 {-# LANGUAGE OverloadedStrings #-}
4 {-# LANGUAGE PatternSynonyms #-}
5 module HUnit.Election where
6
7 import Test.Tasty.HUnit
8 import qualified Data.List as List
9 import qualified System.Random as Random
10
11 import Protocol.Arithmetic
12 import Protocol.Credential
13 import Protocol.Election
14 import Protocol.Trustees.Simple
15
16 import Utils
17
18 hunit :: TestTree
19 hunit = testGroup "Election"
20 [ testGroup "groupGenInverses"
21 [ testCase "WeakParams" $
22 List.take 10 (groupGenInverses @WeakParams) @?=
23 [groupGen^neg (fromNatural n) | n <- [0..9]]
24 , testCase "BeleniosParams" $
25 List.take 10 (groupGenInverses @BeleniosParams) @?=
26 [groupGen^neg (fromNatural n) | n <- [0..9]]
27 ]
28 , testGroup "encryptBallot" $
29 [ testsEncryptBallot @WeakParams
30 , testsEncryptBallot @BeleniosParams
31 ]
32 , testGroup "trustee" $
33 [ testsTrustee @WeakParams
34 ]
35 ]
36
37 testsEncryptBallot :: forall q. Params q => TestTree
38 testsEncryptBallot =
39 testGroup (paramsName @q)
40 [ testEncryptBallot @q 0
41 [Question "q1" ["a1","a2","a3"] zero one]
42 [[True, False, False]]
43 (Right True)
44 , testEncryptBallot @q 0
45 [Question "q1" ["a1","a2","a3"] zero one]
46 [[False, False, False]]
47 (Right True)
48 , testEncryptBallot @q 0
49 [Question "q1" ["a1","a2","a3"] zero one]
50 [[False, False, False]]
51 (Right True)
52 , testEncryptBallot @q 0
53 [Question "q1" [] zero one]
54 []
55 (Left (ErrorBallot_WrongNumberOfAnswers 0 1))
56 , testEncryptBallot @q 0
57 [Question "q1" ["a1","a2"] one one]
58 [[True]]
59 (Left (ErrorBallot_Answer (ErrorAnswer_WrongNumberOfOpinions 1 2)))
60 , testEncryptBallot @q 0
61 [Question "q1" ["a1","a2","a3"] zero one]
62 [[True, True, False]]
63 (Left (ErrorBallot_Answer (ErrorAnswer_WrongSumOfOpinions 2 0 1)))
64 , testEncryptBallot @q 0
65 [Question "q1" ["a1","a2","a3"] one one]
66 [[False, False, False]]
67 (Left (ErrorBallot_Answer (ErrorAnswer_WrongSumOfOpinions 0 1 1)))
68 , testEncryptBallot @q 0
69 [Question "q1" ["a1","a2"] one one]
70 [[False, False, True]]
71 (Left (ErrorBallot_Answer (ErrorAnswer_WrongNumberOfOpinions 3 2)))
72 , testEncryptBallot @q 0
73 [ Question "q1" ["a11","a12","a13"] zero (one+one)
74 , Question "q2" ["a21","a22","a23"] one one
75 ]
76 [ [True, False, True]
77 , [False, True, False] ]
78 (Right True)
79 ]
80
81 testEncryptBallot ::
82 forall q. SubGroup q =>
83 Int -> [Question q] -> [[Bool]] ->
84 Either ErrorBallot Bool ->
85 TestTree
86 testEncryptBallot seed quests opins exp =
87 let verify =
88 runExcept $
89 (`evalStateT` Random.mkStdGen seed) $ do
90 uuid <- randomUUID
91 cred <- randomCredential
92 let ballotSecKey = credentialSecretKey @q uuid cred
93 let elecPubKey = publicKey ballotSecKey -- FIXME: wrong key
94 let elec = Election
95 { election_name = "election"
96 , election_description = "description"
97 , election_publicKey = elecPubKey
98 , election_questions = quests
99 , election_uuid = uuid
100 , election_hash = Hash "" -- FIXME: when implemented
101 }
102 verifyBallot elec
103 <$> encryptBallot elec (Just ballotSecKey) opins
104 in
105 testCase (show opins) $
106 verify @?= exp
107
108 testsTrustee :: forall q. Params q => TestTree
109 testsTrustee =
110 testGroup (paramsName @q)
111 [ testTrustee @q 0 (Right ())
112 ]
113
114 testTrustee ::
115 forall q. SubGroup q =>
116 Int -> Either ErrorTrusteePublicKey () -> TestTree
117 testTrustee seed exp =
118 let verify =
119 runExcept $
120 (`evalStateT` Random.mkStdGen seed) $ do
121 trustSecKey <- randomSecretKey @_ @_ @q
122 trustPubKey <- proveTrusteePublicKey trustSecKey
123 lift $ verifyTrusteePublicKey trustPubKey
124 in
125 testCase (show seed) $
126 verify @?= exp