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