]> Git — Sourcephile - majurity.git/blob - hjugement-protocol/benchmarks/Election.hs
protocol: no change to Helios-C for the MJ
[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 :: forall c. Reifies c FFC => Int -> Int -> Election c
12 makeElection nQuests nChoices = hashElection $ Election
13 { election_name = Text.pack $ "elec"<>show nQuests<>show nChoices
14 , election_description = "benchmarkable election"
15 , election_uuid
16 , election_crypto = ElectionCrypto_FFC (reflect (Proxy::Proxy c)) $
17 let secKey = credentialSecretKey election_uuid (Credential "xLcs7ev6Jy6FHHE") in
18 publicKey secKey
19 , election_hash = Hash ""
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 c -> [[Bool]]
30 makeVotes Election{..} =
31 [ True : List.tail [ False | _choice <- question_choices quest ]
32 | quest <- election_questions
33 ]
34
35 makeBallot :: Reifies c FFC => Election c -> Ballot c
36 makeBallot elec =
37 case runExcept $ (`evalStateT` mkStdGen seed) $ do
38 ballotSecKey <- 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 c -> 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 :: FFC -> Int -> Int -> Benchmark
55 benchEncryptBallot ffc nQuests nChoices =
56 reify ffc $ \(Proxy::Proxy c) ->
57 let setupEnv = do
58 let elec :: Election c = makeElection nQuests nChoices
59 return elec in
60 env setupEnv $ \ ~(elec) ->
61 bench (titleElection elec) $
62 nf makeBallot elec
63
64 benchVerifyBallot :: FFC -> Int -> Int -> Benchmark
65 benchVerifyBallot ffc nQuests nChoices =
66 reify ffc $ \(Proxy::Proxy c) ->
67 let setupEnv = do
68 let elec :: Election c = makeElection nQuests nChoices
69 let ballot = makeBallot elec
70 return (elec,ballot) in
71 env setupEnv $ \ ~(elec, ballot) ->
72 bench (titleElection elec) $
73 nf (verifyBallot 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 "weakFFC"
83 [ bgroup "encryptBallot"
84 [ benchEncryptBallot weakFFC nQuests nChoices
85 | (nQuests,nChoices) <- inputs
86 ]
87 , bgroup "verifyBallot"
88 [ benchVerifyBallot weakFFC nQuests nChoices
89 | (nQuests,nChoices) <- inputs
90 ]
91 ]
92 , bgroup "beleniosFFC"
93 [ bgroup "encryptBallot"
94 [ benchEncryptBallot beleniosFFC nQuests nChoices
95 | (nQuests,nChoices) <- inputs
96 ]
97 , bgroup "verifyBallot"
98 [ benchVerifyBallot beleniosFFC nQuests nChoices
99 | (nQuests,nChoices) <- inputs
100 ]
101 ]
102 ]