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