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