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 (G 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 (G crypto c) =>
  55  Invertible (G crypto c) =>
  56  ToNatural (G crypto c) =>
  57  Election crypto v c -> Ballot crypto v c
  58 makeBallot elec =
  59         case runExcept $ (`evalStateT` mkStdGen seed) $ do
  60                 ballotSecKey <- randomSecretKey
  61                 encryptBallot elec (Just ballotSecKey) $
  62                         makeVotes elec of
  63          Right ballot -> ballot
  64          Left err -> error ("encryptBallot: "<>show err)
  65         where
  66         seed = 0
  67
  68 titleElection :: Election crypto v c -> String
  69 titleElection Election{..} =
  70         Printf.printf "(questions=%i)×(choices=%i)==%i"
  71          nQuests nChoices (nQuests * nChoices)
  72         where
  73         nQuests  = List.length election_questions
  74         nChoices = List.foldr max 0 $ List.length . question_choices <$> election_questions
  75
  76 benchEncryptBallot ::
  77  forall crypto v c.
  78  Reifies v Version =>
  79  Reifies c crypto =>
  80  JSON.ToJSON crypto =>
  81  Group crypto =>
  82  Key crypto =>
  83  NFData crypto =>
  84  NFData (G crypto c) =>
  85  Multiplicative (G crypto c) =>
  86  Invertible (G crypto c) =>
  87  ToNatural (G crypto c) =>
  88  JSON.ToJSON (G crypto c) =>
  89  Proxy v -> Proxy c -> Int -> Int -> Benchmark
  90 benchEncryptBallot (_v::Proxy v) (_c::Proxy c) nQuests nChoices =
  91         let setupEnv = do
  92                 let elec :: Election crypto v c = makeElection nQuests nChoices
  93                 return elec in
  94         env setupEnv $ \ ~(elec) ->
  95                 bench (titleElection elec) $
  96                         nf makeBallot elec
  97
  98 benchVerifyBallot ::
  99  forall crypto v c.
 100  Reifies v Version =>
 101  Reifies c crypto =>
 102  JSON.ToJSON crypto =>
 103  Group crypto =>
 104  Key crypto =>
 105  NFData crypto =>
 106  NFData (G crypto c) =>
 107  Multiplicative (G crypto c) =>
 108  Invertible (G crypto c) =>
 109  ToNatural (G crypto c) =>
 110  JSON.ToJSON (G crypto c) =>
 111  Proxy v -> Proxy c -> Int -> Int -> Benchmark
 112 benchVerifyBallot (_v::Proxy v) (_c::Proxy c) nQuests nChoices =
 113         let setupEnv = do
 114                 let elec :: Election crypto v c = makeElection nQuests nChoices
 115                 let ballot = makeBallot elec
 116                 return (elec,ballot) in
 117         env setupEnv $ \ ~(elec, ballot) ->
 118                 bench (titleElection elec) $
 119                         nf (verifyBallot elec) ballot
 120
 121 benchmarks :: [Benchmark]
 122 benchmarks =
 123  let inputs =
 124          [ (nQ,nC)
 125          | nQ <- [1,5,10,15,20,25]
 126          , nC <- [5,7]
 127          ] in
 128  [ bgroup "stableVersion" $ reify stableVersion $ \v ->
 129          [ bgroup "weakFFC" $ reify weakFFC $ \c ->
 130                  [ bgroup "encryptBallot"
 131                          [ benchEncryptBallot v c nQuests nChoices
 132                          | (nQuests,nChoices) <- inputs
 133                          ]
 134                  , bgroup "verifyBallot"
 135                          [ benchVerifyBallot v c nQuests nChoices
 136                          | (nQuests,nChoices) <- inputs
 137                          ]
 138                  ]
 139          , bgroup "beleniosFFC" $ reify beleniosFFC $ \c ->
 140                  [ bgroup "encryptBallot"
 141                          [ benchEncryptBallot v c nQuests nChoices
 142                          | (nQuests,nChoices) <- inputs
 143                          ]
 144                  , bgroup "verifyBallot"
 145                          [ benchVerifyBallot v c nQuests nChoices
 146                          | (nQuests,nChoices) <- inputs
 147                          ]
 148                  ]
 149          ]
 150  ]