hjugement-protocol/tests/HUnit/Election.hs

   1 {-# LANGUAGE DataKinds #-}
   2 {-# LANGUAGE OverloadedStrings #-}
   3 {-# LANGUAGE PatternSynonyms #-}
   4 module HUnit.Election where
   5
   6 import Test.Tasty.HUnit
   7 import qualified Data.Aeson as JSON
   8 import qualified Data.List as List
   9 import qualified Data.Text as Text
  10 import qualified System.Random as Random
  11
  12 import Voting.Protocol
  13
  14 import Utils
  15
  16 hunit :: Reifies v Version => Proxy v -> TestTree
  17 hunit v = testGroup "Election" $
  18  [ testGroup "groupGenInverses"
  19          [ testCase "WeakParams" $
  20                 reify weakFFC $ \(Proxy::Proxy c) ->
  21                         List.take 10 (groupGenInverses @_ @c) @?=
  22                                 [groupGen^neg (fromNatural n) | n <- [0..9]]
  23          , testCase "BeleniosParams" $
  24                 reify beleniosFFC $ \(Proxy::Proxy c) ->
  25                         List.take 10 (groupGenInverses @_ @c) @?=
  26                                 [groupGen^neg (fromNatural n) | n <- [0..9]]
  27          ]
  28  , testGroup "encryptBallot" $
  29          [ hunitsEncryptBallot v weakFFC
  30          , hunitsEncryptBallot v beleniosFFC
  31          ]
  32  ]
  33
  34 hunitsEncryptBallot ::
  35  ReifyCrypto crypto =>
  36  JSON.ToJSON crypto =>
  37  Key crypto =>
  38  Reifies v Version => Proxy v ->
  39  crypto -> TestTree
  40 hunitsEncryptBallot v crypto =
  41         testGroup (Text.unpack $ cryptoName crypto)
  42          [ hunitEncryptBallot v crypto 0
  43                  [Question "q1" ["a1","a2","a3"] zero one]
  44                  [[True, False, False]]
  45                  (Right True)
  46          , hunitEncryptBallot v crypto 0
  47                  [Question "q1" ["a1","a2","a3"] zero one]
  48                  [[False, False, False]]
  49                  (Right True)
  50          , hunitEncryptBallot v crypto 0
  51                  [Question "q1" ["a1","a2","a3"] zero one]
  52                  [[False, False, False]]
  53                  (Right True)
  54          , hunitEncryptBallot v crypto 0
  55                  [Question "q1" [] zero one]
  56                  []
  57                  (Left (ErrorBallot_WrongNumberOfAnswers 0 1))
  58          , hunitEncryptBallot v crypto 0
  59                  [Question "q1" ["a1","a2"] one one]
  60                  [[True]]
  61                  (Left (ErrorBallot_Answer (ErrorAnswer_WrongNumberOfOpinions 1 2)))
  62          , hunitEncryptBallot v crypto 0
  63                  [Question "q1" ["a1","a2","a3"] zero one]
  64                  [[True, True, False]]
  65                  (Left (ErrorBallot_Answer (ErrorAnswer_WrongSumOfOpinions 2 0 1)))
  66          , hunitEncryptBallot v crypto 0
  67                  [Question "q1" ["a1","a2","a3"] one one]
  68                  [[False, False, False]]
  69                  (Left (ErrorBallot_Answer (ErrorAnswer_WrongSumOfOpinions 0 1 1)))
  70          , hunitEncryptBallot v crypto 0
  71                  [Question "q1" ["a1","a2"] one one]
  72                  [[False, False, True]]
  73                  (Left (ErrorBallot_Answer (ErrorAnswer_WrongNumberOfOpinions 3 2)))
  74          , hunitEncryptBallot v crypto 0
  75                  [ Question "q1" ["a11","a12","a13"] zero (one+one)
  76                  , Question "q2" ["a21","a22","a23"] one one
  77                  ]
  78                  [ [True, False, True]
  79                  , [False, True, False] ]
  80                  (Right True)
  81          ]
  82
  83 hunitEncryptBallot ::
  84  ReifyCrypto crypto =>
  85  JSON.ToJSON crypto =>
  86  Key crypto =>
  87  Reifies v Version => Proxy v ->
  88  crypto -> Int -> [Question v] -> [[Bool]] ->
  89  Either ErrorBallot Bool ->
  90  TestTree
  91 hunitEncryptBallot v election_crypto seed election_questions opins exp =
  92         let got =
  93                 reifyCrypto election_crypto $ \(Proxy::Proxy c) ->
  94                 runExcept $
  95                 (`evalStateT` Random.mkStdGen seed) $ do
  96                         election_uuid <- randomUUID
  97                         cred <- randomCredential
  98                         let ballotSecKey = credentialSecretKey @_ @c election_uuid cred
  99                         election_public_key <- publicKey <$> randomSecretKey
 100                         let elec = Election
 101                                  { election_name        = "election"
 102                                  , election_description = "description"
 103                                  , election_hash        = hashElection elec
 104                                  , election_version     = Just (reflect v)
 105                                  , ..
 106                                  }
 107                         verifyBallot elec
 108                          <$> encryptBallot elec (Just ballotSecKey) opins
 109         in
 110         testCase (show opins) $
 111                 got @?= exp