hjugement-protocol/benchmarks/Election.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 module Election where
   3
   4 import Control.DeepSeq (NFData)
   5 import qualified Data.List as List
   6 import qualified Data.Text as Text
   7 import qualified Text.Printf as Printf
   8 import qualified Data.Aeson as JSON
   9
  10 import Voting.Protocol
  11 import Utils
  12
  13 makeElection ::
  14  forall crypto v c.
  15  Reifies v Version =>
  16  Reifies c crypto =>
  17  JSON.ToJSON crypto =>
  18  JSON.ToJSON (FieldElement crypto c) =>
  19  Key crypto =>
  20  Int -> Int -> Election crypto v c
  21 makeElection nQuests nChoices = elec
  22         where
  23         election_uuid = UUID "xLcs7ev6Jy6FHH"
  24         elec = Election
  25          { election_name = Text.pack $ "elec"<>show nQuests<>show nChoices
  26          , election_description = "benchmarkable election"
  27          , election_uuid
  28          , election_crypto = reflect (Proxy @c)
  29          , election_public_key =
  30                 let secKey = credentialSecretKey election_uuid (Credential "xLcs7ev6Jy6FHHE") in
  31                 publicKey secKey
  32          , election_hash = hashElection elec
  33          , election_version = Just (reflect (Proxy @v))
  34          , election_questions =
  35                 (<$> [1..nQuests]) $ \quest -> Question
  36                  { question_text = Text.pack $ "quest"<>show quest
  37                  , question_choices = (<$> [1..nChoices]) $ \choice -> Text.pack $ "choice"<>show choice
  38                  , question_mini = one
  39                  , question_maxi = one -- sum $ List.replicate nChoices one
  40                  }
  41          }
  42
  43 makeVotes :: Election crypto v c -> [[Bool]]
  44 makeVotes Election{..} =
  45         [ True : List.tail [ False | _choice <- question_choices quest ]
  46         | quest <- election_questions
  47         ]
  48
  49 makeBallot ::
  50  Reifies v Version =>
  51  Reifies c crypto =>
  52  Group crypto =>
  53  Key crypto =>
  54  Multiplicative (FieldElement crypto c) =>
  55  ToNatural (FieldElement crypto c) =>
  56  Election crypto v c -> Ballot crypto v c
  57 makeBallot elec =
  58         case runExcept $ (`evalStateT` mkStdGen seed) $ do
  59                 ballotSecKey <- randomSecretKey
  60                 encryptBallot elec (Just ballotSecKey) $
  61                         makeVotes elec of
  62          Right ballot -> ballot
  63          Left err -> error ("encryptBallot: "<>show err)
  64         where
  65         seed = 0
  66
  67 titleElection :: Election crypto v c -> String
  68 titleElection Election{..} =
  69         Printf.printf "(questions=%i)×(choices=%i)==%i"
  70          nQuests nChoices (nQuests * nChoices)
  71         where
  72         nQuests  = List.length election_questions
  73         nChoices = List.foldr max 0 $ List.length . question_choices <$> election_questions
  74
  75 benchEncryptBallot ::
  76  forall crypto v c.
  77  Reifies v Version =>
  78  Reifies c crypto =>
  79  JSON.ToJSON crypto =>
  80  Group crypto =>
  81  Key crypto =>
  82  NFData crypto =>
  83  NFData (FieldElement crypto c) =>
  84  Multiplicative (FieldElement crypto c) =>
  85  ToNatural (FieldElement crypto c) =>
  86  JSON.ToJSON (FieldElement crypto c) =>
  87  Proxy v -> Proxy c -> Int -> Int -> Benchmark
  88 benchEncryptBallot (_v::Proxy v) (_c::Proxy c) nQuests nChoices =
  89         let setupEnv = do
  90                 let elec :: Election crypto v c = makeElection nQuests nChoices
  91                 return elec in
  92         env setupEnv $ \ ~(elec) ->
  93                 bench (titleElection elec) $
  94                         nf makeBallot elec
  95
  96 benchVerifyBallot ::
  97  forall crypto v c.
  98  Reifies v Version =>
  99  Reifies c crypto =>
 100  JSON.ToJSON crypto =>
 101  Group crypto =>
 102  Key crypto =>
 103  NFData crypto =>
 104  NFData (FieldElement crypto c) =>
 105  Multiplicative (FieldElement crypto c) =>
 106  ToNatural (FieldElement crypto c) =>
 107  JSON.ToJSON (FieldElement crypto c) =>
 108  Proxy v -> Proxy c -> Int -> Int -> Benchmark
 109 benchVerifyBallot (_v::Proxy v) (_c::Proxy c) nQuests nChoices =
 110         let setupEnv = do
 111                 let elec :: Election crypto v c = makeElection nQuests nChoices
 112                 let ballot = makeBallot elec
 113                 return (elec,ballot) in
 114         env setupEnv $ \ ~(elec, ballot) ->
 115                 bench (titleElection elec) $
 116                         nf (verifyBallot elec) ballot
 117
 118 benchmarks :: [Benchmark]
 119 benchmarks =
 120  let inputs =
 121          [ (nQ,nC)
 122          | nQ <- [1,5,10,15,20,25]
 123          , nC <- [5,7]
 124          ] in
 125  [ bgroup "stableVersion" $ reify stableVersion $ \v ->
 126          [ bgroup "weakFFC" $ reify weakFFC $ \c ->
 127                  [ bgroup "encryptBallot"
 128                          [ benchEncryptBallot v c nQuests nChoices
 129                          | (nQuests,nChoices) <- inputs
 130                          ]
 131                  , bgroup "verifyBallot"
 132                          [ benchVerifyBallot v c nQuests nChoices
 133                          | (nQuests,nChoices) <- inputs
 134                          ]
 135                  ]
 136          , bgroup "beleniosFFC" $ reify beleniosFFC $ \c ->
 137                  [ bgroup "encryptBallot"
 138                          [ benchEncryptBallot v c nQuests nChoices
 139                          | (nQuests,nChoices) <- inputs
 140                          ]
 141                  , bgroup "verifyBallot"
 142                          [ benchVerifyBallot v c nQuests nChoices
 143                          | (nQuests,nChoices) <- inputs
 144                          ]
 145                  ]
 146          ]
 147  ]