web: use yarn+spago instead of bower
[majurity.git] / hjugement-protocol / tests / HUnit / Election.hs
index a2f583b68bcf79d3f1283caee85cd099ee153106..1ac482faaa86963999e2c12ab4afd188ffc3833d 100644 (file)
@@ -4,6 +4,7 @@
 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
@@ -12,60 +13,63 @@ import Voting.Protocol
 
 import Utils
 
-hunit :: TestTree
-hunit = testGroup "Election"
+hunit :: Reifies v Version => Proxy v -> TestTree
+hunit v = testGroup "Election" $
  [ testGroup "groupGenInverses"
         [ testCase "WeakParams" $
                reify weakFFC $ \(Proxy::Proxy c) ->
-                       List.take 10 (groupGenInverses @c) @?=
-                               [groupGen^neg (fromNatural n) | n <- [0..9]]
+                       List.take 10 (groupGenInverses @_ @c) @?=
+                               [groupGen^negate (fromNatural n) | n <- [0..9]]
         , testCase "BeleniosParams" $
                reify beleniosFFC $ \(Proxy::Proxy c) ->
-                       List.take 10 (groupGenInverses @c) @?=
-                               [groupGen^neg (fromNatural n) | n <- [0..9]]
+                       List.take 10 (groupGenInverses @_ @c) @?=
+                               [groupGen^negate (fromNatural n) | n <- [0..9]]
         ]
  , testGroup "encryptBallot" $
-        [ testsEncryptBallot weakFFC
-        , testsEncryptBallot beleniosFFC
+        [ hunitsEncryptBallot v weakFFC
+        , hunitsEncryptBallot v beleniosFFC
         ]
  ]
 
-testsEncryptBallot :: FFC -> TestTree
-testsEncryptBallot ffc =
-       testGroup (Text.unpack $ ffc_name ffc)
-        [ testEncryptBallot ffc 0
+hunitsEncryptBallot ::
+ Reifies v Version =>
+ ReifyCrypto crypto => Key crypto => JSON.ToJSON crypto =>
+ Proxy v -> crypto -> TestTree
+hunitsEncryptBallot v crypto =
+       testGroup (Text.unpack $ cryptoName crypto)
+        [ hunitEncryptBallot v crypto 0
                 [Question "q1" ["a1","a2","a3"] zero one]
                 [[True, False, False]]
                 (Right True)
-        , testEncryptBallot ffc 0
+        , hunitEncryptBallot v crypto 0
                 [Question "q1" ["a1","a2","a3"] zero one]
                 [[False, False, False]]
                 (Right True)
-        , testEncryptBallot ffc 0
+        , hunitEncryptBallot v crypto 0
                 [Question "q1" ["a1","a2","a3"] zero one]
                 [[False, False, False]]
                 (Right True)
-        , testEncryptBallot ffc 0
+        , hunitEncryptBallot v crypto 0
                 [Question "q1" [] zero one]
                 []
                 (Left (ErrorBallot_WrongNumberOfAnswers 0 1))
-        , testEncryptBallot ffc 0
+        , hunitEncryptBallot v crypto 0
                 [Question "q1" ["a1","a2"] one one]
                 [[True]]
                 (Left (ErrorBallot_Answer (ErrorAnswer_WrongNumberOfOpinions 1 2)))
-        , testEncryptBallot ffc 0
+        , hunitEncryptBallot v crypto 0
                 [Question "q1" ["a1","a2","a3"] zero one]
                 [[True, True, False]]
                 (Left (ErrorBallot_Answer (ErrorAnswer_WrongSumOfOpinions 2 0 1)))
-        , testEncryptBallot ffc 0
+        , hunitEncryptBallot v crypto 0
                 [Question "q1" ["a1","a2","a3"] one one]
                 [[False, False, False]]
                 (Left (ErrorBallot_Answer (ErrorAnswer_WrongSumOfOpinions 0 1 1)))
-        , testEncryptBallot ffc 0
+        , hunitEncryptBallot v crypto 0
                 [Question "q1" ["a1","a2"] one one]
                 [[False, False, True]]
                 (Left (ErrorBallot_Answer (ErrorAnswer_WrongNumberOfOpinions 3 2)))
-        , testEncryptBallot ffc 0
+        , hunitEncryptBallot v crypto 0
                 [ Question "q1" ["a11","a12","a13"] zero (one+one)
                 , Question "q2" ["a21","a22","a23"] one one
                 ]
@@ -74,29 +78,29 @@ testsEncryptBallot ffc =
                 (Right True)
         ]
 
-testEncryptBallot ::
- FFC -> Int -> [Question] -> [[Bool]] ->
- Either ErrorBallot Bool ->
- TestTree
-testEncryptBallot ffc seed quests opins exp =
+hunitEncryptBallot ::
+ Reifies v Version =>
+ ReifyCrypto crypto => Key crypto => JSON.ToJSON crypto =>
+ Proxy v -> crypto -> Int -> [Question v] -> [[Bool]] ->
+ Either ErrorBallot Bool -> TestTree
+hunitEncryptBallot v election_crypto seed election_questions 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        = hashElection elec
-                                }
-                       verifyBallot elec
-                        <$> encryptBallot elec (Just ballotSecKey) opins
+               reifyCrypto election_crypto $ \(_c::Proxy c) ->
+                       runExcept $
+                       (`evalStateT` Random.mkStdGen seed) $ do
+                               election_uuid <- randomUUID
+                               cred <- randomCredential
+                               let ballotSecKey = credentialSecretKey @_ @c election_uuid cred
+                               election_public_key <- publicKey <$> randomSecretKey
+                               let elec = Election
+                                        { election_name        = "election"
+                                        , election_description = "description"
+                                        , election_hash        = hashElection elec
+                                        , election_version     = Just (reflect v)
+                                        , ..
+                                        }
+                               verifyBallot elec
+                                <$> encryptBallot elec (Just ballotSecKey) opins
        in
        testCase (show opins) $
                got @?= exp