]> Git — Sourcephile - majurity.git/blob - hjugement-protocol/benchmarks/Election.hs
protocol: add preliminary support for trustees
[majurity.git] / hjugement-protocol / benchmarks / Election.hs
1 {-# LANGUAGE OverloadedStrings #-}
2 module Election where
3
4 import qualified Data.List as List
5 import qualified Data.Text as Text
6 import qualified Text.Printf as Printf
7
8 import Voting.Protocol
9 import Utils
10
11 makeElection :: SubGroup q => Int -> Int -> Election q
12 makeElection nQuests nChoices = Election
13 { election_name = Text.pack $ "elec"<>show nQuests<>show nChoices
14 , election_description = "benchmarkable election"
15 , election_uuid
16 , election_publicKey =
17 let secKey = credentialSecretKey election_uuid (Credential "xLcs7ev6Jy6FHHE") in
18 publicKey secKey
19 , election_hash = Hash "" -- FIXME: when implemented
20 , election_questions =
21 (<$> [1..nQuests]) $ \quest -> Question
22 { question_text = Text.pack $ "quest"<>show quest
23 , question_choices = (<$> [1..nChoices]) $ \choice -> Text.pack $ "choice"<>show choice
24 , question_mini = one
25 , question_maxi = one -- sum $ List.replicate nChoices one
26 }
27 } where election_uuid = UUID "xLcs7ev6Jy6FHH"
28
29 makeVotes :: Election q -> [[Bool]]
30 makeVotes Election{..} =
31 [ True : List.tail [ False | _choice <- question_choices quest ]
32 | quest <- election_questions
33 ]
34
35 makeBallot :: forall q. SubGroup q => Election q -> Ballot q
36 makeBallot elec =
37 case runExcept $ (`evalStateT` mkStdGen seed) $ do
38 ballotSecKey :: SecretKey q <- randomSecretKey
39 encryptBallot elec (Just ballotSecKey) $
40 makeVotes elec of
41 Right ballot -> ballot
42 Left err -> error ("encryptBallot: "<>show err)
43 where
44 seed = 0
45
46 titleElection :: Election q -> String
47 titleElection Election{..} =
48 Printf.printf "(questions=%i)×(choices=%i)==%i"
49 nQuests nChoices (nQuests * nChoices)
50 where
51 nQuests = List.length election_questions
52 nChoices = List.foldr max 0 $ List.length . question_choices <$> election_questions
53
54 benchEncryptBallot :: forall q. Params q => Int -> Int -> Benchmark
55 benchEncryptBallot nQuests nChoices =
56 env setupEnv $ \ ~elec ->
57 bench (titleElection elec) $
58 nf makeBallot elec
59 where
60 setupEnv = do
61 let elec :: Election q = makeElection nQuests nChoices
62 return elec
63
64 benchVerifyBallot :: forall q. Params q => Int -> Int -> Benchmark
65 benchVerifyBallot nQuests nChoices =
66 env setupEnv $ \ ~(elec,ballot) ->
67 bench (titleElection elec) $
68 nf (verifyBallot elec) ballot
69 where
70 setupEnv = do
71 let elec :: Election q = makeElection nQuests nChoices
72 let ballot = makeBallot elec
73 return (elec,ballot)
74
75 benchmarks :: [Benchmark]
76 benchmarks =
77 let inputs =
78 [ (nQ,nC)
79 | nQ <- [1,5,10,15,20,25]
80 , nC <- [5,7]
81 ] in
82 [ bgroup "WeakParams"
83 [ bgroup "encryptBallot"
84 [ benchEncryptBallot @WeakParams nQuests nChoices
85 | (nQuests,nChoices) <- inputs
86 ]
87 , bgroup "verifyBallot"
88 [ benchVerifyBallot @BeleniosParams nQuests nChoices
89 | (nQuests,nChoices) <- inputs
90 ]
91 ]
92 , bgroup "BeleniosParams"
93 [ bgroup "encryptBallot"
94 [ benchEncryptBallot @BeleniosParams nQuests nChoices
95 | (nQuests,nChoices) <- inputs
96 ]
97 , bgroup "verifyBallot"
98 [ benchVerifyBallot @BeleniosParams nQuests nChoices
99 | (nQuests,nChoices) <- inputs
100 ]
101 ]
102 ]