hjugement-protocol/tests/HUnit/Election.hs

   1 {-# LANGUAGE AllowAmbiguousTypes #-}
   2 {-# LANGUAGE DataKinds #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4 {-# LANGUAGE PatternSynonyms #-}
   5 module HUnit.Election where
   6
   7 import Test.Tasty.HUnit
   8 import qualified Data.List as List
   9 import qualified System.Random as Random
  10
  11 import Voting.Protocol
  12 import Voting.Protocol.Trustees.All
  13
  14 import Utils
  15
  16 hunit :: TestTree
  17 hunit = testGroup "Election"
  18  [ testGroup "groupGenInverses"
  19          [ testCase "WeakParams" $
  20                 List.take 10 (groupGenInverses @WeakParams) @?=
  21                         [groupGen^neg (fromNatural n) | n <- [0..9]]
  22          , testCase "BeleniosParams" $
  23                 List.take 10 (groupGenInverses @BeleniosParams) @?=
  24                         [groupGen^neg (fromNatural n) | n <- [0..9]]
  25          ]
  26  , testGroup "encryptBallot" $
  27          [ testsEncryptBallot @WeakParams
  28          , testsEncryptBallot @BeleniosParams
  29          ]
  30  , testGroup "trustee" $
  31          [ testsTrustee @WeakParams
  32          ]
  33  ]
  34
  35 testsEncryptBallot :: forall q. Params q => TestTree
  36 testsEncryptBallot =
  37         testGroup (paramsName @q)
  38          [ testEncryptBallot @q 0
  39                  [Question "q1" ["a1","a2","a3"] zero one]
  40                  [[True, False, False]]
  41                  (Right True)
  42          , testEncryptBallot @q 0
  43                  [Question "q1" ["a1","a2","a3"] zero one]
  44                  [[False, False, False]]
  45                  (Right True)
  46          , testEncryptBallot @q 0
  47                  [Question "q1" ["a1","a2","a3"] zero one]
  48                  [[False, False, False]]
  49                  (Right True)
  50          , testEncryptBallot @q 0
  51                  [Question "q1" [] zero one]
  52                  []
  53                  (Left (ErrorBallot_WrongNumberOfAnswers 0 1))
  54          , testEncryptBallot @q 0
  55                  [Question "q1" ["a1","a2"] one one]
  56                  [[True]]
  57                  (Left (ErrorBallot_Answer (ErrorAnswer_WrongNumberOfOpinions 1 2)))
  58          , testEncryptBallot @q 0
  59                  [Question "q1" ["a1","a2","a3"] zero one]
  60                  [[True, True, False]]
  61                  (Left (ErrorBallot_Answer (ErrorAnswer_WrongSumOfOpinions 2 0 1)))
  62          , testEncryptBallot @q 0
  63                  [Question "q1" ["a1","a2","a3"] one one]
  64                  [[False, False, False]]
  65                  (Left (ErrorBallot_Answer (ErrorAnswer_WrongSumOfOpinions 0 1 1)))
  66          , testEncryptBallot @q 0
  67                  [Question "q1" ["a1","a2"] one one]
  68                  [[False, False, True]]
  69                  (Left (ErrorBallot_Answer (ErrorAnswer_WrongNumberOfOpinions 3 2)))
  70          , testEncryptBallot @q 0
  71                  [ Question "q1" ["a11","a12","a13"] zero (one+one)
  72                  , Question "q2" ["a21","a22","a23"] one one
  73                  ]
  74                  [ [True, False, True]
  75                  , [False, True, False] ]
  76                  (Right True)
  77          ]
  78
  79 testEncryptBallot ::
  80  forall q. SubGroup q =>
  81  Int -> [Question q] -> [[Bool]] ->
  82  Either ErrorBallot Bool ->
  83  TestTree
  84 testEncryptBallot seed quests opins exp =
  85         let verify =
  86                 runExcept $
  87                 (`evalStateT` Random.mkStdGen seed) $ do
  88                         uuid <- randomUUID
  89                         cred <- randomCredential
  90                         let ballotSecKey = credentialSecretKey @q uuid cred
  91                         let elecPubKey = publicKey ballotSecKey -- FIXME: wrong key
  92                         let elec = Election
  93                                  { election_name        = "election"
  94                                  , election_description = "description"
  95                                  , election_publicKey   = elecPubKey
  96                                  , election_questions   = quests
  97                                  , election_uuid        = uuid
  98                                  , election_hash        = Hash "" -- FIXME: when implemented
  99                                  }
 100                         verifyBallot elec
 101                          <$> encryptBallot elec (Just ballotSecKey) opins
 102         in
 103         testCase (show opins) $
 104                 verify @?= exp
 105
 106 testsTrustee :: forall q. Params q => TestTree
 107 testsTrustee =
 108         testGroup (paramsName @q)
 109          [ testTrustee @q 0 (Right ())
 110          ]
 111
 112 testTrustee ::
 113  forall q. SubGroup q =>
 114  Int -> Either ErrorTrusteePublicKey () -> TestTree
 115 testTrustee seed exp =
 116         let verify =
 117                 runExcept $
 118                 (`evalStateT` Random.mkStdGen seed) $ do
 119                         trustSecKey <- randomSecretKey @_ @_ @q
 120                         trustPubKey <- proveTrusteePublicKey trustSecKey
 121                         lift $ verifyTrusteePublicKey trustPubKey
 122         in
 123         testCase (show seed) $
 124                 verify @?= exp