{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} module HUnit.Election where import Test.Tasty.HUnit import qualified Data.Aeson as JSON import qualified Data.List as List import qualified Data.Text as Text import qualified System.Random as Random import Voting.Protocol import Utils hunit :: TestTree hunit = testGroup "Election" [ testGroup "groupGenInverses" [ testCase "WeakParams" $ reify weakFFC $ \(Proxy::Proxy c) -> List.take 10 (groupGenInverses @c) @?= [groupGen^neg (fromNatural n) | n <- [0..9]] , testCase "BeleniosParams" $ reify beleniosFFC $ \(Proxy::Proxy c) -> List.take 10 (groupGenInverses @c) @?= [groupGen^neg (fromNatural n) | n <- [0..9]] ] , testGroup "encryptBallot" $ [ testsEncryptBallot weakFFC , testsEncryptBallot beleniosFFC ] ] testsEncryptBallot :: FFC -> TestTree testsEncryptBallot ffc = testGroup (Text.unpack $ ffc_name ffc) [ testEncryptBallot ffc 0 [Question "q1" ["a1","a2","a3"] zero one] [[True, False, False]] (Right True) , testEncryptBallot ffc 0 [Question "q1" ["a1","a2","a3"] zero one] [[False, False, False]] (Right True) , testEncryptBallot ffc 0 [Question "q1" ["a1","a2","a3"] zero one] [[False, False, False]] (Right True) , testEncryptBallot ffc 0 [Question "q1" [] zero one] [] (Left (ErrorBallot_WrongNumberOfAnswers 0 1)) , testEncryptBallot ffc 0 [Question "q1" ["a1","a2"] one one] [[True]] (Left (ErrorBallot_Answer (ErrorAnswer_WrongNumberOfOpinions 1 2))) , testEncryptBallot ffc 0 [Question "q1" ["a1","a2","a3"] zero one] [[True, True, False]] (Left (ErrorBallot_Answer (ErrorAnswer_WrongSumOfOpinions 2 0 1))) , testEncryptBallot ffc 0 [Question "q1" ["a1","a2","a3"] one one] [[False, False, False]] (Left (ErrorBallot_Answer (ErrorAnswer_WrongSumOfOpinions 0 1 1))) , testEncryptBallot ffc 0 [Question "q1" ["a1","a2"] one one] [[False, False, True]] (Left (ErrorBallot_Answer (ErrorAnswer_WrongNumberOfOpinions 3 2))) , testEncryptBallot ffc 0 [ Question "q1" ["a11","a12","a13"] zero (one+one) , Question "q2" ["a21","a22","a23"] one one ] [ [True, False, True] , [False, True, False] ] (Right True) ] testEncryptBallot :: FFC -> Int -> [Question] -> [[Bool]] -> Either ErrorBallot Bool -> TestTree testEncryptBallot ffc seed quests opins exp = let got = reify ffc $ \(Proxy::Proxy c) -> runExcept $ (`evalStateT` Random.mkStdGen seed) $ do uuid <- randomUUID cred <- randomCredential let ballotSecKey = credentialSecretKey @c uuid cred elecPubKey <- publicKey <$> randomSecretKey let elec = Election { election_name = "election" , election_description = "description" , election_crypto = ElectionCrypto_FFC ffc elecPubKey , election_questions = quests , election_uuid = uuid , election_hash = hashJSON JSON.Null } verifyBallot elec <$> encryptBallot elec (Just ballotSecKey) opins in testCase (show opins) $ got @?= exp